Excel VBA connect SAPRFC

This is simple and you don't have to install those development tools to run the code. Is just required Microsoft excel you can connect into your SAP R/3. No other tools required, no need the extra software installed and mainly is using Excel VBA run the code and you able to retrieve/import data on your SAP R/3 data.

Required item:

This is the items required to start your tutorial:

  1. Microsoft excel.
  2. SAP Login id and password.
  3. SAP program with remote function call. I will show your my customized RFC coding in my SAP ABAP. The RFC program name is "ZMM_PRPORS"
  4. SAP Gui installed
One more setting you have to do before start the coding. You have to add SAP reference below:

1. Go to Developer tab -> Click the Visual Basic:






2. Go to Tools -> References

3. Click those SAP references show as below and click OK.


Excel VBA Coding

Double click on the sheet1 and pasted code below.










Please fill in your SAP ip address, client, system id, system number, SAP user id and password. Make sure you have the correct info in SAP connection.

___________________________________________________

Option Explicit

Dim objBAPIControl, objGetdata As Object

Dim vLastRow, vCols, DPT, PLT, PGR, ACA, ITC As Integer

Dim vcount_add, index_add As Integer

Dim PREV_OBJ As String

Public objinput, objausp, objt16fs As SAPTableFactoryCtrl.Table


Private Sub GetData_Click()

 'Local variables

  Dim LogonControl As SAPLogonCtrl.SAPLogonControl

  Dim R3Connection As SAPLogonCtrl.Connection

  Dim retcd        As Boolean

  Dim SilentLogon  As Boolean

  Dim R            As Integer
  
  Dim num          As Integer
  

 'Set Connection

  Set LogonControl = CreateObject("SAP.LogonControl.1")

  Set objBAPIControl = CreateObject("SAP.Functions")

  Set R3Connection = LogonControl.NewConnection

  

 'SAP connection

  R3Connection.Client = "100"

  R3Connection.ApplicationServer = "xxxxxx"

  R3Connection.Language = "EN"

  R3Connection.User = "<userid>"

  R3Connection.Password = "<password>"

  R3Connection.System = "DEV"

  R3Connection.SystemNumber = "00"

  R3Connection.UseSAPLogonIni = False

  SilentLogon = False
  

  retcd = R3Connection.Logon(0, SilentLogon)

  If retcd <> True Then MsgBox "Logon failed": Exit Sub

  objBAPIControl.Connection = R3Connection

  

 'Assign the Parameters

  Set objGetdata = objBAPIControl.Add("ZMM_PRPORS")

  Set objt16fs = objGetdata.Tables("ET_T16FS")

  Set objausp = objGetdata.Tables("ET_AUSP_LIST")

  Set objinput = objGetdata.Tables("ET_OBJEK")

 'Assign customer
  Sheets("Release Strategy").Select
  
  For R = 164 To 400
  num = num + 1
  If ThisWorkbook.ActiveSheet.Cells(R, 2).Value <> "" Then

    objinput.Rows.Add

    objinput.Value(num, "SIGN") = ThisWorkbook.ActiveSheet.Cells(R, 2).Value

    objinput.Value(num, "OPTION") = ThisWorkbook.ActiveSheet.Cells(R, 3).Value

    objinput.Value(num, "LOW") = ThisWorkbook.ActiveSheet.Cells(R, 4).Value

    objinput.Value(num, "HIGH") = ThisWorkbook.ActiveSheet.Cells(R, 5).Value
  
  Else
    Exit For
  End If
  Next
  vCols = 1
  PREV_OBJ = ""
  objGetdata.Call

  vcount_add = objausp.Rows.Count

    For index_add = 1 To vcount_add
      If objausp.Value(index_add, "OBJEK") <> PREV_OBJ Then
          PGR = 97
          PLT = 10
          DPT = 127
          ACA = 121
          ITC = 155
          PREV_OBJ = objausp.Value(index_add, "OBJEK")
          vCols = vCols + 1
      End If

      ActiveSheet.Cells(1, vCols) = objausp.Value(index_add, "OBJEK")  'Object
        
      Select Case objausp.Value(index_add, "ATINN")
      Case "0000000835"     'Purchasing Grp
        PGR = PGR + 1
        If PGR < 120 Then
            ActiveSheet.Cells(PGR, vCols) = objausp.Value(index_add, "ATWRT")  'Value
        End If
      Case "0000000836"     'PR/PO Doc Type
        ActiveSheet.Cells(10, vCols) = objausp.Value(index_add, "ATWRT")  'Value
      Case "0000000841"     'Plant Level
        PLT = PLT + 1
        If PLT < 98 Then
            ActiveSheet.Cells(PLT, vCols) = objausp.Value(index_add, "ATWRT")  'Value
        End If
      Case "0000000855"     'Account assignment
        ACA = ACA + 1
        If ACA < 128 Then
            ActiveSheet.Cells(ACA, vCols) = objausp.Value(index_add, "ATWRT")  'Value
        End If
      Case "0000000856"     'Department
        DPT = DPT + 1
        If DPT < 156 Then
            ActiveSheet.Cells(DPT, vCols) = objausp.Value(index_add, "ATWRT")  'Value
        End If
      Case "0000000838"     'USD Value
          Select Case objausp.Value(index_add, "ATCOD")  'Code
                Case 3 'GE value from LE Value TO
                ActiveSheet.Cells(120, vCols) = objausp.Value(index_add, "ATFLV") & " - " & objausp.Value(index_add, "ATFLB") 'Value from
                Case 6 'Less Than
                ActiveSheet.Cells(120, vCols) = " < " & objausp.Value(index_add, "ATFLB") 'Value TO
                Case 7 ' Less than or equals
                ActiveSheet.Cells(120, vCols) = " <= " & objausp.Value(index_add, "ATFLB") 'Value TO
                Case 8 'Greater Than
                ActiveSheet.Cells(120, vCols) = " > " & objausp.Value(index_add, "ATFLV") 'Value from
                Case 9 'Greater Than
                ActiveSheet.Cells(120, vCols) = " >= " & objausp.Value(index_add, "ATFLB") 'Value TO
          End Select
      Case "0000000840"     'MYR Value
          Select Case objausp.Value(index_add, "ATCOD")  'Code
                Case 3 'GE value from LE Value TO
                ActiveSheet.Cells(121, vCols) = objausp.Value(index_add, "ATFLV") & " - " & objausp.Value(index_add, "ATFLB") 'Value from
                Case 6 'Less Than
                ActiveSheet.Cells(121, vCols) = " < " & objausp.Value(index_add, "ATFLB") 'Value TO
                Case 8 'Greater Than
                ActiveSheet.Cells(121, vCols) = " > " & objausp.Value(index_add, "ATFLV") 'Value from
                Case 9 'Greater Than
                ActiveSheet.Cells(121, vCols) = " >= " & objausp.Value(index_add, "ATFLB") 'Value TO
          End Select
      Case "0000000871"     'Item Cat
        ITC = ITC + 1
        If ITC < 160 Then
            ActiveSheet.Cells(ITC, vCols) = objausp.Value(index_add, "ATWRT")  'Value
        End If
      End Select
    

    Next index_add
  
  vcount_add = objt16fs.Rows.Count

    For index_add = 1 To vcount_add
    vCols = 1

        Do While Right(ActiveSheet.Cells(1, vCols), 2) <> objt16fs.Value(index_add, "FRGSX")
            vCols = vCols + 1
        Loop
        If Right(ActiveSheet.Cells(1, vCols), 2) = objt16fs.Value(index_add, "FRGSX") Then
            ActiveSheet.Cells(2, vCols) = objt16fs.Value(index_add, "FRGXT")  'Value
            ActiveSheet.Cells(3, vCols) = objt16fs.Value(index_add, "FRGSX")  'Value
            ActiveSheet.Cells(5, vCols) = objt16fs.Value(index_add, "FRGC1")  'Value
            ActiveSheet.Cells(6, vCols) = objt16fs.Value(index_add, "FRGC2")  'Value
            ActiveSheet.Cells(7, vCols) = objt16fs.Value(index_add, "FRGC3")  'Value
            ActiveSheet.Cells(8, vCols) = objt16fs.Value(index_add, "FRGC4")  'Value
            ActiveSheet.Cells(9, vCols) = objt16fs.Value(index_add, "FRGC5")  'Value
        End If
    Next index_add

  'If address not exist then show error

  If vcount_add = "" Then

    ActiveSheet.Cells(162, 12) = "Invalid Input"

  Else

    ActiveSheet.Cells(163, 12) = "BAPI Call is successfull"

    ActiveSheet.Cells(164, 12) = vcount_add & " rows are returned"

  End If

  

  R3Connection.Logoff

End Sub


Private Sub ResetOutput_Click()

Range("B1:XFD159").Select
Selection.ClearContents

Range("L162:L164").Select
Selection.ClearContents

End Sub

'(Note: Button properties need to be set)
___________________________________________________


SAP ABAP Coding

Enter t-code SE37 and create function name "ZMM_PRPORS" then change processing type to Remote-Enabled module.


Here the the import/export table. 

ET_AUSP_LIST - This is SAP AUSP table. Use t-code SE11 to create structure.

ET_T16FS_LIST - This is SAP T16FS table. Use t-code SE11 to create structure.











ET_T16FS_LIST - This is SAP T16FS table. Use t-code SE11 to create structure.
















RFC Coding:
______________________________________________________________________________

FUNCTION ZMM_PRPORS.
*"----------------------------------------------------------------------
*"*"Local Interface:
*"  TABLES
*"      ET_AUSP_LIST STRUCTURE  ZMM_AUSP_LIST
*"      ET_T16FS STRUCTURE  ZMM_T16FS_LIST
*"      ET_OBJEK STRUCTURE  ZAUS_OBJNUM
*"----------------------------------------------------------------------
DATA: DESC LIKE T16FT-FRGXT.
IF NOT ET_OBJEK[] IS INITIAL.

  SELECT  OBJEK
          ATINN
          ATZHL
          MAFID
          KLART
          ADZHL
          ATWRT
          ATFLV
          ATAWE
          ATFLB
          ATAW1
          ATCOD
    INTO TABLE ET_AUSP_LIST
    FROM AUSP
    WHERE OBJEK IN ET_OBJEK.

    IF sy-subrc <> 0.
        Clear: et_AUSP_list.
    ELSE.
      Sort et_ausp_list by  OBJEK ATINN ATWRT.
    ENDIF.

        SELECT * INTO CORRESPONDING FIELDS OF TABLE ET_T16FS
             FROM T16FS
             FOR ALL ENTRIES IN et_AUSP_List
             WHERE FRGGR EQ et_AUSP_List-objek(2)
               AND FRGSX EQ et_AUSP_List-objek+2(2).

        IF SY-SUBRC EQ 0.

          Sort et_t16fs by FRGSX.

          LOOP AT ET_T16FS.
              SELECT SINGLE FRGXT INTO DESC
                FROM T16FT
               WHERE FRGGR EQ ET_T16FS-FRGGR
                 AND FRGSX EQ ET_T16FS-FRGSX.

                MOVE DESC TO ET_T16FS-FRGXT.
                MODIFY ET_T16FS.
          ENDLOOP.

        ENDIF.
ENDIF.

ENDFUNCTION.

Download excel file here.


Comments

  1. Mr Clever20 December 2019 at 19:18

    Thanks for the post!

    One question, How do you pass credentials in a Single Sign On (SSO) environment. From my windows desktop I'm automatically logged in, and can't see any attributes from the SAP Launchpad, is there a way to derive this information or is the process altogether different ? Thanks in advance!

    ReplyDelete
  2. Brian Chan11 May 2020 at 19:54

    Hi, I’ve try on the SSO environment and it most more a easy after you have setup every just click on the button and execute with to worry to type the user name and password.

    ReplyDelete
  3. anjali26 October 2020 at 03:13

    How to check , whether the same SAP user is already logged in SAP applicaiton. This is to avoid multiuser login .

    ReplyDelete
  4. Brian Chan3 December 2020 at 18:51

    You have to check in sapgui using transaction code SM04 to view it.

    ReplyDelete
  5. hema28 April 2021 at 05:37

    Great Post with valuable information. I am glad that I have visited this site. Share more updates.

    Manual Testing Online Course
    Learn Excel Vba Online


    ReplyDelete
  6. Brian Chan28 June 2021 at 06:32

    thank you for the comment

    ReplyDelete

Post a Comment

Popular posts from this blog

How to Create Sap Gui Scripting

Image
SAP GUI Scripting syntax similar like VBScript and you can used setup your testing data or data migration from legacy system to SAP. Is easy and less time to create sap gui scripting compared to LSMW. Sap Gui Scripting it can migrated master data and Transaction data as well. I will showed you how to create it. Here the step by step to create your sap gui script 1. Click on the Script Recording and Playback 2. Click on  More button, you can changed the filename and path. 3. Click on Record button and type "SU01" to lock user id. 4. Once you have completed then click Stop button. 5. Here the script you recorded. If Not IsObject(application) Then    Set SapGuiAuto  = GetObject("SAPGUI")    Set application = SapGuiAuto.GetScriptingEngine End If If Not IsObject(connection) Then    Set connection = application.Children(0) End If If Not IsObject(session) Then    Set session    = con...
Read more

Simple macros to re-arrange column into upload format

Image
Excel macros to re-arrange column from text file into rows format. Please watch the video below. 1.  Create 2 Macros name in you excel. 2.  All Macros code have to paste in  Module1. 3.  Copy Macros's code below. Sub Remove() '   Delete title line     Rows("1:5").Select     Selection.Delete Shift:=xlUp      '     For i = 1 To 9000         Range("A" & i).Select         If Left(ActiveCell.Value, 1) = "-" Then             Rows(i & ":" & i).Select             Selection.Delete Shift:=xlUp         End If     Next      '   Delete column B and D     Columns("B:B").Select     Selection.Delete Shift:=xlToLeft          Columns("D:D").Select     Selection.Delete S...
Read more