SAPBEXgetConnection doesn't return proper values when BEX is open via RRMX

Question

had to put a lot of interactivity in some workbook based on the user profile and going far beyond the simple authorisation objects.
Following the advice of some specialists such as Peter Knoer, I used the following code to get the user connection details:
<i>Set myConnection = Run("SAPBEX.XLA!SAPBEXgetConnection")
With myConnection ' call the connection
Sheets("BAPI").Cells(27, 2).Value = myConnection.Client
Sheets("BAPI").Cells(28, 2).Value = myConnection.User
Sheets("BAPI").Cells(29, 2).Value = myConnection.language
Sheets("BAPI").Cells(30, 2).Value = myConnection.SystemNumber
Sheets("BAPI").Cells(31, 2).Value = myConnection.System
Sheets("BAPI").Cells(32, 2).Value = myConnection.ApplicationServer
End With</i>
Everything works fine as long as the user first launch BEX and connect directly in BEX.
This command function fails if BEX is launch from SAP EasyAccess Menu via the RRMX transaction.
Any clue why this function does not work in the case of a launch via RRMX?
I tried several alternative, is there a better Function to use to get all the user connection details in this case?
thanks for your insights on this point.

Answer 1

Hi Peter,
why do I need to test what is the current login?
I had the request to make truly dynamic workbook based on user profile: logo, workbook label based on user language  etc.
To do so, I need to pass either the user name or the system number or the language to two RFC/BAPI functions from excel. Have a look at the complete macro below:
+Sub BAPIUserDetail()
'Declaration for the necessary objects
Dim myConnection, myConnection2, objLogonControl, objBAPIControl, objConnection, objUserDetail, objUserName, objTranslation, objTranslationTable As Object
Dim objTranslationDelimiter As Object
Dim objTranslationOptions As Table
Sheets("BAPI").Range("B27:B33").Value = ""
Set myConnection = Run("SAPBEX.XLA!SAPBEXgetConnection")
With myConnection ' call the connection
Sheets("BAPI").Cells(27, 2).Value = myConnection.Client
Sheets("BAPI").Cells(28, 2).Value = myConnection.User
Sheets("BAPI").Cells(29, 2).Value = myConnection.language
Sheets("BAPI").Cells(30, 2).Value = myConnection.SystemNumber
Sheets("BAPI").Cells(31, 2).Value = myConnection.System
Sheets("BAPI").Cells(32, 2).Value = myConnection.ApplicationServer
'.UseSAPLogonIni = False 'important for automatic connection
'.Logon 0, True ' This will provide a dialog to appear
'If .IsConnected <> 1 Then
'.Logon 0, False
'If .IsConnected <> 1 Then Exit Sub
'End If
End With
'Run "sapbex.xla!sapbexinit"
' if the user launch bex via SAPGUI easyaccess, sometimes the connection parameter fails
Dim objVerifyConnection As String
objVerifyConnection = Sheets("BAPI").Cells(27, 2).Value
If objVerifyConnection = "" Then
'Close completely the connection to BW !
Run "sapbex.xla!dialOut", True, True
'We warn-out the user that BEX connection is not correct
MsgBox "ATTENTION: Les Parametres de Connection de votre BEX ne sont pas correctement transmis depuis votre SAPGUI. Veuillez vous reconnecter et relancer la derniere requête."
'We recreate a new connection via SAPlogon dialog and relaunch the first query in the sequence of SAPBEXqueries worksheet
Dim r As Range
Set r = Range("SAPBEXqueries!SAPBEXq0003")
Run "sapbex.xla!SAPBEXrefresh", False, r
'We get another time all the connection parameter in the BAPI sheet
Set myConnection2 = Run("SAPBEX.XLA!SAPBEXgetConnection")
With myConnection2 ' call the connection
Sheets("BAPI").Cells(27, 2).Value = myConnection2.Client
Sheets("BAPI").Cells(28, 2).Value = myConnection2.User
Sheets("BAPI").Cells(29, 2).Value = myConnection2.language
Sheets("BAPI").Cells(30, 2).Value = myConnection2.SystemNumber
Sheets("BAPI").Cells(31, 2).Value = myConnection2.System
Sheets("BAPI").Cells(32, 2).Value = myConnection2.ApplicationServer
End With
End If
'Create automatic connection for the user USER_BAPI to gather the Entity and Logo parameters linked to the user connected
Set objBAPIControl = CreateObject("SAP.Functions") 'Create ActiveX object
'Specify user
objBAPIControl.Connection.User = "USER_BAPI"
'Then password
objBAPIControl.Connection.Password = "BOUYGUES"
'Client
objBAPIControl.Connection.Client = Sheets("BAPI").Cells(27, 2).Value
'Target server address
objBAPIControl.Connection.ApplicationServer = Sheets("BAPI").Cells(32, 2).Value
'Language code
objBAPIControl.Connection.language = Sheets("BAPI").Cells(29, 2).Value
'System ID
objBAPIControl.Connection.System = Sheets("BAPI").Cells(31, 2).Value
'System Number
objBAPIControl.Connection.SystemNumber = Sheets("BAPI").Cells(30, 2).Value
'Finally, try to logon to the specified system and check if the connection established
If objBAPIControl.Connection.Logon(0, True) <> True Then
MsgBox "Cannot Log on to SAP" 'Issue message if cannot logon
Else
'  MsgBox "Logged on to SAP!"
End If
On Error Resume Next
' BAPI_USER_GET_DETAIL to get the user's parameter1 values
Set objUserDetail = objBAPIControl.Add("BAPI_USER_GET_DETAIL")
Set objUserName = objUserDetail.exports("USERNAME")
objUserName.Value = Sheets("BAPI").Cells(15, 2).Value
' Function call
objUserDetail.call
' Getting the result set in a table
Dim objTable As Table
Set objTable = objUserDetail.Tables("PARAMETER1")
' Printing the number of company codes
'MsgBox "Row count :" & objTable.RowCount
Sheets("BAPI").Cells(16, 2) = objTable.RowCount
' Clearing the PARAMETER1 Table on the Excel Sheet
Sheets("BAPI").Range("A18:C25").Value = ""
' Saving the PARAMETER1 Table to the Excel Sheet
For i = 1 To objTable.RowCount
Sheets("BAPI").Cells(17 + i, 1) = objTable.Cell(i, 1)
Sheets("BAPI").Cells(17 + i, 2) = objTable.Cell(i, 2)
Next i
'if any error then displaying the same to the users
If Err Then
    MsgBox Err.Description
End If
' Determine the standard SAP language code
Dim language As String
language = Sheets("BAPI").Cells(29, 2).Value
Select Case language
'FR
Case "FR"
Sheets("BAPI").Cells(16, 5).Value = "F"
'EN
Case "EN"
Sheets("BAPI").Cells(16, 5).Value = "E"
'DE
Case "DE"
Sheets("BAPI").Cells(16, 5).Value = "D"
'ES
Case "ES"
Sheets("BAPI").Cells(16, 5).Value = "S"
'Empty Language
Case ""
Sheets("BAPI").Cells(16, 5).Value = "F"
Case Else
Sheets("BAPI").Cells(16, 5).Value = "F"
End Select
' RFC_READ_TABLE to get all the translation for the text label according to user preference
Set objTranslation = objBAPIControl.Add("RFC_READ_TABLE")
Set objTranslationTable = objTranslation.exports("QUERY_TABLE")
objTranslationTable.Value = Sheets("BAPI").Cells(8, 5).Value
Set objTranslationDelimiter = objTranslation.exports("DELIMITER")
objTranslationDelimiter.Value = Sheets("BAPI").Cells(10, 5).Value
Set objTranslationSkips = objTranslation.exports("ROWSKIPS")
objTranslationSkips.Value = "0"
Set objTranslationCount = objTranslation.exports("ROWCOUNT")
objTranslationCount.Value = "0"
'Define the filters for the OPTIONS table
Dim area As String
Dim langu As String
area = Sheets("BAPI").Cells(14, 5)
langu = Sheets("BAPI").Cells(16, 5)
Set objTranslationOptions = objTranslation.Tables("OPTIONS")
objTranslationOptions.AppendRow
objTranslationOptions(1, "TEXT") = "AREA = '" & area & "' AND LANGU = '" & langu & "'"
' Function call
objTranslation.call
' Getting the result set in a table
Dim objTTable As Table
Set objTTable = objTranslation.Tables("DATA")
' Printing the number of company codes
'MsgBox "Row count :" & objTTable.RowCount
Sheets("BAPI").Cells(12, 5) = objTTable.RowCount
' Clearing the  Table on the Excel Sheet
Sheets("BAPI").Range("G7:Z10000").Value = ""
' Saving the  Table to the Excel Sheet
For i = 1 To objTTable.RowCount
Sheets("BAPI").Cells(6 + i, 7) = objTTable.Cell(i, 1)
Next i
'Convert to column the semicolon delimited text from the
Dim objRange1 As Range
    'Set up the ranges
    Set objRange1 = Sheets("BAPI").Range("G7:G10000")
    'Do the first parse
    objRange1.TextToColumns _
      Destination:=Range("G7"), _
      DataType:=xlDelimited, _
      Tab:=False, _
      Semicolon:=True, _
      Comma:=False, _
      Space:=False, _
      Other:=False, _
      OtherChar:="-"
'Replace the * by the € symbol, there is a pb with this caracter in the RFC_READ_TABLE
  Dim Cell As Variant
    For Each Cell In Sheets("BAPI").Range("K7:K1000")
        Cell.Value = Replace(Cell.Value, "*", "€")
    Next Cell
'Insert logo in the BAPI worksheet
Dim objPic As Object
Dim ApplicationServer As String
Dim logo As String
ApplicationServer = Sheets("BAPI").Cells(32, 2).Value
logo = Sheets("BAPI").Cells(20, 5).Value
If logo = "Langue!" Then
MsgBox "Attention: Il n'y a pas d'Entité et de Logo associés à votre profile! Veuillez contacter votre Administrateur."
Else
'Assign inserted image to an object
Set objPic = Worksheets("BAPI").Pictures.Insert("http://" & ApplicationServer & ".bouygues-construction.com:8000/sap/bw/Mime/BEx/Bouygues%20Logos/" & logo & ".gif")
objPic.Left = 400
objPic.Top = 300
objPic.Name = "MyLogo"
objPic.Height = 100
' using the name reference to change width
'Worksheets("BAPI").Shapes("MyLogo").Width = Worksheets("BAPI").Shapes("MyLogo").Width / 4
'if any error then displaying the same to the users
'Insert logo in the BAPI worksheet
Dim objMainPic As Object
'Dim ApplicationServer As String
'Dim logo As String
'ApplicationServer = Sheets("BAPI").Cells(32, 2).Value
'logo = Sheets("BAPI").Cells(20, 5).Value
'Assign inserted image to an object
Set objMainPic = Worksheets("TBD dynamique").Pictures.Insert("http://" & ApplicationServer & ".bouygues-construction.com:8000/sap/bw/Mime/BEx/Bouygues%20Logos/" & logo & ".gif")
objMainPic.Left = 30
objMainPic.Top = 30
objMainPic.Name = "MyMainLogo"
'objMainPic.Height = 100
' using the name reference to change width
Worksheets("TBD dynamique").Shapes("MyMainLogo").Width = Worksheets("TBD dynamique").Shapes("MyMainLogo").Width * 0.9
End If
If Err Then
    MsgBox Err.Description
End If
'log off for the USER_BAPI
objBAPIControl.Connection.Logoff
End Sub+
But as I said the SAPBEXgetConnection  does not behave the same way if login is done directly done in BEX or via RRMX. Any Clue?