BAPI Access from Excel using VBA

[Former Member]

Im writing an excel macro (VBA) to call a bapi that populates a spreadsheet.

The user will then do some manipulation of the data collected, and then it must be sent back to sap.

The Bapi in question is BAPI_GET_USER_DETAIL

*"  IMPORTING
*"     VALUE(USERNAME) LIKE  BAPIBNAME-BAPIBNAME
*"  EXPORTING
*"     VALUE(LOGONDATA) LIKE  BAPILOGOND STRUCTURE  BAPILOGOND
*"     VALUE(DEFAULTS) LIKE  BAPIDEFAUL STRUCTURE  BAPIDEFAUL
*"     VALUE(ADDRESS) LIKE  BAPIADDR3 STRUCTURE  BAPIADDR3
*"     VALUE(COMPANY) LIKE  BAPIUSCOMP STRUCTURE  BAPIUSCOMP
*"     VALUE(SNC) LIKE  BAPISNCU STRUCTURE  BAPISNCU
*"     VALUE(REF_USER) LIKE  BAPIREFUS STRUCTURE  BAPIREFUS
*"     VALUE(ALIAS) LIKE  BAPIALIAS STRUCTURE  BAPIALIAS
*"  TABLES
*"      PARAMETER STRUCTURE  BAPIPARAM OPTIONAL
*"      PROFILES STRUCTURE  BAPIPROF OPTIONAL
*"      ACTIVITYGROUPS STRUCTURE  BAPIAGR OPTIONAL
*"      RETURN STRUCTURE  BAPIRET2
*"      ADDTEL STRUCTURE  BAPIADTEL OPTIONAL
*"      ADDFAX STRUCTURE  BAPIADFAX OPTIONAL
*"      ADDTTX STRUCTURE  BAPIADTTX OPTIONAL
*"      ADDTLX STRUCTURE  BAPIADTLX OPTIONAL
*"      ADDSMTP STRUCTURE  BAPIADSMTP OPTIONAL
*"      ADDRML STRUCTURE  BAPIADRML OPTIONAL
*"      ADDX400 STRUCTURE  BAPIADX400 OPTIONAL
*"      ADDRFC STRUCTURE  BAPIADRFC OPTIONAL
*"      ADDPRT STRUCTURE  BAPIADPRT OPTIONAL
*"      ADDSSF STRUCTURE  BAPIADSSF OPTIONAL
*"      ADDURI STRUCTURE  BAPIADURI OPTIONAL
*"      ADDPAG STRUCTURE  BAPIADPAG OPTIONAL
*"      ADDCOMREM STRUCTURE  BAPICOMREM OPTIONAL
*"      GROUPS STRUCTURE  BAPIGROUPS OPTIONAL

Ive Managed to glean from various sources on the internet, the various basics on doing a bapi call from VBA

Here is what i have so far.

Private Sub Fetch_User_details_Click()
'Take username in cell 2,2 and check to see it it exists.
'Display the First and Last name of the user
'Get list of all roles and their expiry dates and populate list
Dim R3, MyFunc, App As Object
Dim SEL_TAB, NAMETAB, TABENTRY, ROW As Object
Dim Result As Boolean
Dim iRow, iColumn, iStart, iStartRow As Integer
'**********************************************
'RFC Paramaters
'**********************************************
Dim Pusername As Variant
Dim Preturn As Variant
Dim copyFromc As String
'**********************************************
'Clear Table Section of Spreadsheet
'**********************************************
Worksheets("Sheet1").Select
For x = 9 To 200
  For y = 1 To 8
    Worksheets("Sheet1").Cells(x, y).ClearContents
    Next y
Next x
'**********************************************
'Create Server object and Setup the connection
'**********************************************
Set R3 = CreateObject("SAP.Functions")
R3.Connection.System = ""
R3.Connection.client = ""
R3.Connection.user = ""
R3.Connection.Password = ""
R3.Connection.Language = "EN"
'**********************************************
'Logon to SAP
'**********************************************
If R3.Connection.logon(0, False) <> True Then
   Exit Sub
End If
'R3.loglevel = 9
'R3.logfilename = "c:guilog.txt"
Set MyFunc = R3.Add("BAPI_USER_GET_DETAIL")
copyFromc = Worksheets("Sheet1").Cells(3, 2).Text
Set Pusername = MyFunc.exports("USERNAME")
Pusername.Value = copyFromc
'**********************************************
'Call the BAPI
'**********************************************
If MyFunc.call Then
'**********************************************
'  ok now what ?
'**********************************************
' Process the returned data into the spreadsheet

   
Else
    MsgBox ("Call returned FALSE")
End If
'**********************************************
'Close Connection to SAP
'**********************************************
R3.Connection.logoff
End Sub

To update the data ( User Role Assignements ) i will be using bapi BAPI_USER_ACTGROUPS_ASSIGN

*"----------------------------------------------------------------------
*"*"Lokale Schnittstelle:
*"  IMPORTING
*"     VALUE(USERNAME) LIKE  BAPIBNAME-BAPIBNAME
*"  TABLES
*"      ACTIVITYGROUPS STRUCTURE  BAPIAGR
*"      RETURN STRUCTURE  BAPIRET2
*"----------------------------------------------------------------------
* Dieser Baustein ist gleichgestellt mit der Pflege eines Benutzers
* über die Pflegetransaktion, gepflegt werden die Felder, für die die
* Pflege erlaubt ist

I need help deciphering the data received from the bapi and then repackaging it using VBA.

I know writing this in ABAP would take less than 30 mins, but that is not an option for me.

[Former Member]

Ok, Ive made some headway

I can now Read all the data i need from SAP

Now comes the bit to write it back again. Will Update when i have a solution

Private Sub copydata_Click()
Dim x1 As Integer, x2 As Integer

'copy all data from "Copy From" to "Copy To"
'first determine how many rows contain roles
'before copying the roles, check that the destination user has no roles assigned
If Cells(9, 6).Text <> "" Then
   MsgBox ("Error. Destination User already has Roles assigned.")
   Exit Sub
End If
For x1 = 0 To 1000
   If Cells(9 + x1, 1).Text = "" Then
     Exit For
   End If
Next
Worksheets("Sheet1").Range(Cells(9, 1), Cells(9 + x1 - 1, 4)).Copy _
   Destination:=Worksheets("Sheet1").Range(Cells(9, 6), Cells(9 + x1, 9))
For x2 = 1 To x1
Worksheets("Sheet1").Cells(9 + x2 - 1, 8).Value = Date
Next
End Sub

Sub Mail_small_Text_Outlook()
' Is working in Office 2000-2007
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)
    strbody = "User " & Worksheets("Sheet1").Cells(3, 7).Text & _
              " Has Been Moddelled off of User " & _
                Worksheets("Sheet1").Cells(3, 2).Text & " in system " & _
                Worksheets("Connection").Cells(1, 2).Text & vbNewLine & vbNewLine & _
              "Please Adjust Mitigating Controls Accordingly"
    On Error Resume Next
    With OutMail
        .To = Worksheets("Connection").Cells(10, 2).Text
        .CC = ""
        .BCC = ""
        .Subject = "User Modelled"
        .Body = strbody
        .Send   'or use .Display
    End With
    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

Private Sub Fetch_CopyTo_User_Click()

'Take username in cell 3,7 and check to see it it exists.
'Display the First and Last name of the user
'Get list of all roles and their expiry dates and populate list
Dim R3, MyFunc, App As Object
Dim SEL_TAB, NAMETAB, TABENTRY, ROW As Object
Dim Result As Boolean
Dim iRow, iColumn, iStart, iStartRow As Integer
'**********************************************
'RFC Paramaters
'**********************************************
Dim Pusername As Object
Dim PAddress As Object
Dim PTable As Object
Dim Preturn As Object
Dim copyFromc As String
'**********************************************
'Clear Table Section of Spreadsheet
'**********************************************
Worksheets("Sheet1").Cells(5, 8).ClearContents
Worksheets("Sheet1").Cells(6, 8).ClearContents
'**********************************************
'Create Server object and Setup the connection
'**********************************************
Set R3 = CreateObject("SAP.Functions")
R3.Connection.System = Worksheets("Connection").Cells(1, 2).Text
R3.Connection.SystemNumber = Worksheets("Connection").Cells(2, 2).Text
R3.Connection.Destination = Worksheets("Connection").Cells(3, 2).Text
R3.Connection.HostName = Worksheets("Connection").Cells(4, 2).Text
R3.Connection.client = Worksheets("Connection").Cells(5, 2).Text
R3.Connection.user = Worksheets("Connection").Cells(6, 2).Text
R3.Connection.Password = Worksheets("Connection").Cells(7, 2).Text
R3.Connection.Language = Worksheets("Connection").Cells(8, 2).Text
'**********************************************
'Logon to SAP
'**********************************************
If R3.Connection.Logon(0, -1) <> True Then
   MsgBox ("We Had a Logon Error")
   Exit Sub
End If
'R3.loglevel = 9
'R3.logfilename = "c:\guilog.txt"
Set MyFunc = R3.Add("BAPI_USER_GET_DETAIL")
Set Pusername = MyFunc.exports("USERNAME")
Set PAddress = MyFunc.imports("ADDRESS")
Set Preturn = MyFunc.tables("RETURN")
Set PTable = MyFunc.tables("ACTIVITYGROUPS")
Pusername.Value = Worksheets("Sheet1").Cells(3, 7).Text
'**********************************************
'Call the BAPI
'**********************************************
If MyFunc.call Then
   Dim xxx As String
   Worksheets("Sheet1").Cells(5, 7).Value = PAddress.Value("FIRSTNAME")
   Worksheets("Sheet1").Cells(6, 7).Value = PAddress.Value("LASTNAME")
'**********************************************
'Get Assigned Roles
'**********************************************
   Dim datarec As Object
   Dim datafld As Object
   x = 9
   For Each datarec In PTable.Rows
     Worksheets("Sheet1").Cells(x, 6).Value = datarec("AGR_NAME")
     Worksheets("Sheet1").Cells(x, 7).Value = datarec("AGR_TEXT")
     Worksheets("Sheet1").Cells(x, 8).Value = datarec("FROM_DAT")
     Worksheets("Sheet1").Cells(x, 9).Value = datarec("TO_DAT")
     x = x + 1
   Next
   copydata.Enabled = True
Else
    MsgBox ("Error Calling Function - Probably Authorizations")
End If
'**********************************************
'Close Connection to SAP
'**********************************************
R3.Connection.logoff
End Sub


Private Sub Fetch_User_details_Click()

'Take username in cell 3,2 and check to see it it exists.
'Display the First and Last name of the user
'Get list of all roles and their expiry dates and populate list
Dim R3, MyFunc, App As Object
Dim SEL_TAB, NAMETAB, TABENTRY, ROW As Object
Dim Result As Boolean
Dim iRow, iColumn, iStart, iStartRow As Integer
'**********************************************
'RFC Paramaters
'**********************************************
Dim Pusername As Object
Dim PAddress As Object
Dim PTable As Object
Dim Preturn As Object
Dim copyFromc As String
'**********************************************
'Clear Table Section and other areas of Spreadsheet
'**********************************************
Worksheets("Sheet1").Select
For x = 9 To 1000
  For y = 1 To 9
    Worksheets("Sheet1").Cells(x, y).ClearContents
    Next y
Next x
Worksheets("Sheet1").Cells(5, 2).ClearContents
Worksheets("Sheet1").Cells(6, 2).ClearContents
Worksheets("Sheet1").Cells(5, 7).ClearContents
Worksheets("Sheet1").Cells(6, 7).ClearContents
copydata.Enabled = False

'**********************************************
'Create Server object and Setup the connection
'**********************************************
Set R3 = CreateObject("SAP.Functions")
R3.Connection.System = Worksheets("Connection").Cells(1, 2).Text
R3.Connection.SystemNumber = Worksheets("Connection").Cells(2, 2).Text
R3.Connection.Destination = Worksheets("Connection").Cells(3, 2).Text
R3.Connection.HostName = Worksheets("Connection").Cells(4, 2).Text
R3.Connection.client = Worksheets("Connection").Cells(5, 2).Text
R3.Connection.user = Worksheets("Connection").Cells(6, 2).Text
R3.Connection.Password = Worksheets("Connection").Cells(7, 2).Text
R3.Connection.Language = Worksheets("Connection").Cells(8, 2).Text
'**********************************************
'Logon to SAP
'**********************************************
If R3.Connection.Logon(0, -1) <> True Then
   MsgBox ("We Had a Logon Error")
   Exit Sub
End If
'R3.loglevel = 9
'R3.logfilename = "c:\guilog.txt"
Set MyFunc = R3.Add("BAPI_USER_GET_DETAIL")
Set Pusername = MyFunc.exports("USERNAME")
Set PAddress = MyFunc.imports("ADDRESS")
Set Preturn = MyFunc.tables("RETURN")
Set PTable = MyFunc.tables("ACTIVITYGROUPS")
Pusername.Value = Worksheets("Sheet1").Cells(3, 2).Text
'**********************************************
'Call the BAPI
'**********************************************
If MyFunc.call Then
   Dim xxx As String
   Worksheets("Sheet1").Cells(5, 2).Value = PAddress.Value("FIRSTNAME")
   Worksheets("Sheet1").Cells(6, 2).Value = PAddress.Value("LASTNAME")
'**********************************************
'Get Assigned Roles
'**********************************************
   Dim datarec As Object
   Dim datafld As Object
   x = 9
   For Each datarec In PTable.Rows
     Worksheets("Sheet1").Cells(x, 1).Value = datarec("AGR_NAME")
     Worksheets("Sheet1").Cells(x, 2).Value = datarec("AGR_TEXT")
     Worksheets("Sheet1").Cells(x, 3).Value = datarec("FROM_DAT")
     Worksheets("Sheet1").Cells(x, 4).Value = datarec("TO_DAT")
     x = x + 1
   Next
Else
    MsgBox ("Error Calling Function - Probably Authorizations")
End If
'**********************************************
'Close Connection to SAP
'**********************************************
R3.Connection.logoff
End Sub

Private Sub UpdateSap_Click()
'
End Sub