EXCEL VBA Macro to Download SAP Table contents

Here is the Code to download any SAP table contents to excel without login in to SAP GUI.

Function Module RFC_READ_TABLE is used to get the table contents.

 Sub Read_Table()  
  Dim LogonControl As Object  
  Dim R3Connection As Object  
  Dim retcd    As Boolean  
  Dim SilentLogon As Boolean  
  Dim returnFunc As Boolean  
  Dim objTableContent As Object  
  Dim tOptions As Object  
  Dim tFields As Object  
  Dim tData As Object  
  Dim RowData$()  
  Dim j&, i&, k&  
 'Set Connection  
  Set LogonControl = CreateObject("SAP.LogonControl.1")  
  Set objBAPIControl = CreateObject("SAP.Functions")  
  Set R3Connection = LogonControl.NewConnection  
  Dim boBapiService As Object  
 'SAP connection  
  R3Connection.client = Sheet4.Cells(3, 2).Value  
  R3Connection.ApplicationServer = Sheet4.Cells(4, 2).Value  
  R3Connection.Language = Sheet4.Cells(5, 2).Value  
  R3Connection.User = ""  
  R3Connection.Password = ""  
  R3Connection.System = Sheet4.Cells(6, 2).Value  
  R3Connection.SystemNumber = Sheet4.Cells(7, 2).Value  
  R3Connection.UseSAPLogonIni = False  
  SilentLogon = False  
  Dim oMsgReturn As Object  
  Dim oMsgText As String  
  retcd = R3Connection.logon(0, SilentLogon)  
  If retcd <> True Then MsgBox "Logon failed": Exit Sub  
  objBAPIControl.Connection = R3Connection  
 'Call the Function Module by BAPI Service  
   Set objTableContent = objBAPIControl.Add("RFC_READ_TABLE")  
   With objTableContent  
     .exports("QUERY_TABLE") = Sheet4.Cells(15, 2).Value  
     .exports("DELIMITER") = Sheet4.Cells(16, 2).Value  
   End With  
   Set tOptions = objTableContent.Tables("OPTIONS")  
   Set tFields = objTableContent.Tables("FIELDS")  
   Set tData = objTableContent.Tables("DATA")  
   tOptions.Rows.Add  
   tOptions(1, "TEXT") = Sheet4.Cells(17, 2).Value  
 '  tOptions.Rows.Add  
 '  tOptions(2, "TEXT") = Sheet4.Cells(4, 2).Value  
 '  tOptions.Rows.Add  
 '  tOptions(3, "TEXT") = Sheet4.Cells(5, 2).Value  
 '  
 '  
 '  tOptions.Rows.Add  
 '  tOptions(1, "TEXT") = "BUKRS = '1000' "  
 '  tOptions.Rows.Add  
 '  tOptions(2, "TEXT") = "AND WT_EXDT GE '20110101' "  
 '  tOptions.Rows.Add  
 '  tOptions(3, "TEXT") = "AND WT_EXDT LE '20111231' "  
 '  tFields.Rows.Add  
 '  tFields(1, "FIELDNAME") = "BUKRS"  
 '  tFields.Rows.Add  
 '  tFields(2, "FIELDNAME") = "LIFNR"  
 '  tFields.Rows.Add  
 '  tFields(3, "FIELDNAME") = "WT_SUBJCT"  
 '  tFields.Rows.Add  
 '  tFields(4, "FIELDNAME") = "WT_WTSTCD"  
 '  tFields.Rows.Add  
 '  tFields(5, "FIELDNAME") = "WT_WITHCD"  
 '  tFields.Rows.Add  
 '  tFields(6, "FIELDNAME") = "WT_EXNR"  
 '  tFields.Rows.Add  
 '  tFields(7, "FIELDNAME") = "WT_EXRT"  
 '  tFields.Rows.Add  
 '  tFields(8, "FIELDNAME") = "WT_EXDF"  
 '  tFields.Rows.Add  
 '  tFields(9, "FIELDNAME") = "WT_EXDT"  
   tFields.Rows.Add  
   tFields(1, "FIELDNAME") = Sheet4.Cells(21, 1).Value  
   tFields.Rows.Add  
   tFields(2, "FIELDNAME") = Sheet4.Cells(21, 2).Value  
   tFields.Rows.Add  
   tFields(3, "FIELDNAME") = Sheet4.Cells(21, 3).Value  
   tFields.Rows.Add  
   tFields(4, "FIELDNAME") = Sheet4.Cells(21, 4).Value  
   tFields.Rows.Add  
   tFields(5, "FIELDNAME") = Sheet4.Cells(21, 5).Value  
   tFields.Rows.Add  
   tFields(6, "FIELDNAME") = Sheet4.Cells(21, 6).Value  
   tFields.Rows.Add  
   tFields(7, "FIELDNAME") = Sheet4.Cells(21, 7).Value  
   tFields.Rows.Add  
   tFields(8, "FIELDNAME") = Sheet4.Cells(21, 8).Value  
   tFields.Rows.Add  
   tFields(9, "FIELDNAME") = Sheet4.Cells(21, 9).Value  
 'if value is returned by BAPI call copy it to worksheet  
   returnFunc = objTableContent.Call  
   If returnFunc = True Then  
     j = tData.RowCount  
     MsgBox ("Row count :" & tData.RowCount)  
     If j Then  
       For i = 1 To j  
         RowData = Split(tData(i, "WA"), "|")  
         For k = 1 To 9  
           Sheet4.Cells(21 + i, k).Value = RowData(k - 1)  
         Next  
       Next  
     End If  
   Else  
     MsgBox "Error when accessing BAPI in R/3 ! "  
     Exit Sub  
   End If  
   objBAPIControl.Connection.logoff  
   Set R3Connection = Nothing  
   MsgBox "Done!", 0, "Exit"  
 End Sub  

OUTPUT