Consider the below code for educational purposes only. Avoid using RFC_READ_TABLE as it’s not released by SAP – see note 382318 – FAQ|Function module RFC_READ_TABLE.

A piece of code, that has been for sure posted many times – how to fetch SAP table data with VBA from within an Excel or MS Access.

However this time the added value is that local MS Access table is created on the fly, based on SAP table structure.

RFC_READ_TABLE(tableName, columnNames, filter, local_table_name)

where tableName – SAP table name to fetch

     columnNames – string, coma separated column names to fetch. If empty string “”, then all table fields are retrieved.

     filter – string, WHERE clause in the ABAP SQL syntax

     local_table_name – string, local table name to be created

Example 1:

RFC_READ_TABLE(“MAST”, “MATNR,WERKS,STLAN,STLNR,STLAL”, “WERKS = ‘XX10′”, “MY_MAST”)

… will create local table MY_MAST, with given columns for all MAST records for plant XX10

Example 2:

RFC_READ_TABLE(“MARD”, “MATNR,LGORT,LGPBE”, “LGORT = ‘XX60’ or LGORT = ‘XX61′”, “MY_MARD”)

… will create local table MY_MARD, with columns MATNR,LGORT,LGPBE, where LGORD is either XX60 or XX61

Example 3:

RFC_READ_TABLE(“MARD”, “”, “LGORT = ‘XX60’ or LGORT = ‘XX61′”, “MY_MARD2”)

… will create local table MY_MARD2, with all SAP table columns, where LGORD is either XX60 or XX61

Remark: I recommend to use BBP_RFC_READ_TABLE instead of RFC_READ_TABLE, as with the plain RFC_READ_TABLE I had performance problems and crash dumps on large tables.


Public Function RFC_READ_TABLE(tableName, columnNames, filter, table_name)
Dim R3 As Object, MyFunc As Object, App As Object
' Define the objects to hold IMPORT parameters
Dim QUERY_TABLE As Object
Dim DELIMITER   As Object
Dim NO_DATA     As Object
Dim ROWSKIPS    As Object
Dim ROWCOUNT    As Object
' Where clause
Dim OPTIONS As Object
' Fill with fields to return.  After function call will hold
' detailed information about the columns of data (start position
' of each field, length, etc.
Dim FIELDS  As Object
' Holds the data returned by the function
Dim DATA    As Object
' Use to write out results
Dim ROW As Object
Dim Result As Boolean
Dim i As Long, j As Long, iRow As Long
Dim iColumn As Long, iStart As Long, iStartRow As Long, iField As Long, iLength As Long
Dim outArray, vArray, vField
Dim iLine As Long
Dim noOfElements As Long
'**********************************************
'Create Server object and Setup the connection
'use same credentials as SAP GUI DLogin
On Error GoTo abend:
  Set R3 = CreateObject("SAP.Functions")
' Fill below logon details
  R3.Connection.ApplicationServer = "x.x.x.x"
   R3.Connection.SystemNumber = "00"
    R3.Connection.System = "XX1"
    R3.Connection.Client = "120"
    R3.Connection.Password = "password"
  R3.Connection.User = "user"
  R3.Connection.Language = "EN"
  If R3.Connection.Logon(0, True) <> True Then
   RFC_READ_TABLE = "ERROR - Logon to SAP Failed"
   Exit Function
  End If
'**********************************************
'*****************************************************
'Call RFC function RFC_READ_TABLE
'*****************************************************
  Set MyFunc = R3.Add("BBP_RFC_READ_TABLE")
   Set QUERY_TABLE = MyFunc.exports("QUERY_TABLE")
   Set DELIMITER = MyFunc.exports("DELIMITER")
   Set NO_DATA = MyFunc.exports("NO_DATA")
   Set ROWSKIPS = MyFunc.exports("ROWSKIPS")
   Set ROWCOUNT = MyFunc.exports("ROWCOUNT")
   Set OPTIONS = MyFunc.tables("OPTIONS")
   Set FIELDS = MyFunc.tables("FIELDS")
   QUERY_TABLE.Value = tableName
   DELIMITER.Value = ""
   NO_DATA = ""
   ROWSKIPS = "0"
   ROWCOUNT = "0"
   OPTIONS.Rows.Add
   OPTIONS.Value(1, "TEXT") = filter ' where filter
    vArray = Split(columnNames, ",") ' columns
    j = 1
    For Each vField In vArray
        If vField <> "" Then
            FIELDS.Rows.Add
            FIELDS.Value(j, "FIELDNAME") = vField
            j = j + 1
        End If
    Next
   Result = MyFunc.Call
   If Result = True Then
     Set DATA = MyFunc.tables("DATA")
     Set FIELDS = MyFunc.tables("FIELDS")
     Set OPTIONS = MyFunc.tables("OPTIONS")
     R3.Connection.LogOFF
   Else
     R3.Connection.LogOFF
     DLog "SAP RFC Error: " & MyFunc.EXCEPTION
     Exit Function
   End If
  noOfElements = FIELDS.ROWCOUNT
  iRow = 0
  iColumn = 0
  'ReDim outArray(0 To DATA.ROWCOUNT, 0 To noOfElements - 1)
  'For Each ROW In FIELDS.Rows
  '  outArray(iRow, iColumn) = ROW("FIELDNAME")
  '  iColumn = iColumn + 1
  'Next
'Display Contents of the table
'**************************************
iRow = 1
iColumn = 1
Dim l As String
Dim fipos
ReDim fipos(1 To FIELDS.ROWCOUNT, 1 To 3)
Dim db As DAO.Database
Set db = CurrentDb()
Dim sql As String
Dim r As String
On Error Resume Next
db.Execute "DROP TABLE " & table_name & ";"
If Err.Number <> 0 Then
    DLog "DROP TABLE Error: " & Err.Description
End If
On Error GoTo abend:
sql = "CREATE TABLE " & table_name & " ("
Dim sql_ins As String, sql_ins_l As String
'sql_ins = "INSERT INTO " & table_name & " ("
For iColumn = 1 To FIELDS.ROWCOUNT
    fipos(iColumn, 1) = FIELDS(iColumn, "OFFSET") + 1
    fipos(iColumn, 2) = CInt(FIELDS(iColumn, "LENGTH"))
    fipos(iColumn, 3) = FIELDS(iColumn, "FIELDNAME")
    If iColumn = FIELDS.ROWCOUNT Then
        sql = sql & FIELDS(iColumn, "FIELDNAME") & " CHAR(" & fipos(iColumn, 2) & "));"
        'sql_ins = sql_ins & FIELDS(iColumn, "FIELDNAME") & ") VALUES ("
    Else
        sql = sql & FIELDS(iColumn, "FIELDNAME") & " CHAR(" & fipos(iColumn, 2) & "), "
        'sql_ins = sql_ins & FIELDS(iColumn, "FIELDNAME") & ", "
    End If
Next
db.Execute sql
'DLog ("Saving " & DATA.ROWCOUNT & " records in local table " & table_name)
Dim rs As Recordset
Dim le As Long
Set rs = db.OpenRecordset(table_name, dbOpenTable, dbAppendOnly)
BeginTrans
For iLine = 1 To DATA.ROWCOUNT
    l = DATA(iLine, "WA")
    'sql_ins_l = sql_ins
    le = Len(l)
    rs.AddNew
    For iColumn = 1 To FIELDS.ROWCOUNT
         If fipos(iColumn, 1) > le Then
             'outArray(iRow, iColumn - 1) = Null
             'sql_ins_l = sql_ins_l & "NULL"
             GoTo skipme:
         Else
            rs.FIELDS(fipos(iColumn, 3)) = Trim(Mid(l, fipos(iColumn, 1), fipos(iColumn, 2)))
             'outArray(iRow, iColumn - 1) = Mid(l, fipos(iColumn, 1), fipos(iColumn, 2))
             'sql_ins_l = sql_ins_l & "'" & Replace(Mid(l, fipos(iColumn, 1), fipos(iColumn, 2)), "'", "''") & "'"
         End If
         'If iColumn = FIELDS.ROWCOUNT Then
         '   sql_ins_l = sql_ins_l & ") "
         'Else
         '   sql_ins_l = sql_ins_l & ", "
         'End If
         'rs.Update
    Next
skipme:
    rs.Update
    'db.Execute sql_ins_l
Next
CommitTrans
RFC_READ_TABLE = outArray
Exit Function
abend:
RFC_READ_TABLE = Err.Description
End Function
To report this post you need to login first.

Be the first to leave a comment

You must be Logged on to comment or reply to a post.

Leave a Reply