RFC_READ_TABLE data into MS Access (along with the table structure)

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