Import tables directly into Access from SAP using RFCs

Access is an invaluable tool for data migration, transformation and manipulation. By calling a series of queries through a macro it is possible to automate all of the transformation steps and reduce the risk of corruption caused by manual processing.

One way to get the contents of a table is to export it to a text file and then import it into Access. Part of this can be automated through macros and VBA, but it includes cumbersome manual steps and each is prone to error.

Pulling the data into Access using Remote Function Calls (RFCs) into the SAP system is very easy. It requires only a user account with appropriate permissions and the libraries that are installed along with Office and the SAPGui client.

RFC calls from Access can be included in a Macro in the event that the data must be the most recent available. A good example is this obsolescence determination tool that requires current data extracted from a legacy SAP system.

The RFC_READ_TABLE function accepts as parameters the name of the SAP table, the name of the table to be created (or replaced) in Access and a comma-delimited string containing the names of the fields to be extracted. In this example the fields MATNR, LVORM, MSTAE, MSTAV, ERSDA and MTART are pulled from the SAP MARA table into the Access tblMARA table.

Function ReadFromSAP() As Boolean
    Dim x
    x = RFC_READ_TABLE("MARA", "tblMARA", "MATNR,LVORM,MSTAE,MSTAV,ERSDA,MTART")
End Function

The system information and user credentials can be hard-coded into the function, but in the sample below they are passed in via the TempVars variables. This code uses a library that is installed as part of the SAPGui program and will not work without SAPGui installed.

Function RFC_READ_TABLE(strSAPTable As String, strTableName As String, strFields As String) As Boolean

    Dim strTemp As String
    
    'Create the database parallel to SAP's . . .
    Dim nCounter As Long, nCurrent As Long
    Dim dbs As dao.Database
    Set dbs = CurrentDb
    Dim tdf As dao.TableDef
    Dim fld1 As dao.Field
    Dim fld2 As dao.Field
    Dim fName As String
    Dim fType As Integer
    Dim fSize As Integer
    Dim nFieldData(999, 2) As Long
    Dim strRow As String
    Dim strFieldnames() As String
    Dim vField As Variant
    Dim j As Integer
    Dim rs As Recordset
    Dim SQL As String
    Dim nCurRec As Long, nCurSec As Long
    Dim isUpdate As Boolean
    Dim strFieldName As String
    Dim nRowCount As Long
    Dim nTotalRecords As Long

    Dim RetVal As Variant, nSecondsLeft As Long, nTotalSeconds As Long
    
    Dim R3, MyFunc, 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
    
    ' Define the objects to hold the EXPORT parameters
    ' None for RFC_TABLE_READ

    ' Define the objects to hold the TABLES parameters
    ' 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 iRow, iColumn, iStart, iStartRow, iField, iLength As Integer
    
    '**********************************************
    'Create Server object and Setup the connection
    '**********************************************
    
    Dim strSAP_System As String
    Dim strSAP_SystemNumber As String
    Dim strSAP_Client As String
    Dim strSAP_User As String
    Dim strSAP_Password As String
    Dim strSAP_Language As String
    Dim strSAP_ApplicationServer As String

    nTotalSeconds = 0

    Set R3 = CreateObject("SAP.Functions")
    R3.Connection.System = [TempVars]![SAP_System]
    R3.Connection.SystemNumber = [TempVars]![SAP_SystemNumber]
    R3.Connection.client = [TempVars]![SAP_Client]
    R3.Connection.User = [TempVars]![SAP_User]
    R3.Connection.Password = [TempVars]![SAP_Password]
    R3.Connection.language = "EN"
    R3.Connection.ApplicationServer = [TempVars]![SAP_ApplicationServer]
       
    RetVal = SysCmd(acSysCmdSetStatus, "Connecting to " & strSAP_System & " . . . ")

    If R3.Connection.logon(0, True) <> True Then
       If R3.Connection.logon(0, False) <> True Then
            Exit Function
       End If
    End If

    '*****************************************************
    'Call RFC function RFC_READ_TABLE
    '*****************************************************
    Set MyFunc = R3.Add("RFC_READ_TABLE")

    ' Set the Objects to the parameter they will return
    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 = strSAPTable
    DELIMITER.Value = vbTab
    NO_DATA = ""
    
    j = 0
    strFieldnames = Split(strFields, ",")
    For Each vField In strFieldnames
        j = j + 1
        FIELDS.Rows.Add
        FIELDS.Value(j, "FIELDNAME") = vField
    Next
    
    RetVal = SysCmd(acSysCmdSetStatus, "Extracting " & j & " fields from table " & strSAPTable & " in " & strSAP_System & " . . . ")

    Result = MyFunc.CALL

    If Result = True Then
        Set DATA = MyFunc.Tables("DATA")
        Set FIELDS = MyFunc.Tables("FIELDS")
        Set OPTIONS = MyFunc.Tables("OPTIONS")
    Else
        MsgBox MyFunc.EXCEPTION
        R3.Connection.LOGOFF
        Exit Function
    End If
    
    '*******************************************
    'Quit the SAP Application
    '*******************************************
    R3.Connection.LOGOFF
    
    If Result <> True Then
      MsgBox (MyFunc.EXCEPTION)
      Exit Function
    End If


    nTotalColumns = FIELDS.ROWCOUNT
    'Check for existence of TargetTable
    nCounter = 0
    Do While nCounter < dbs.TableDefs.Count
        If dbs.TableDefs(nCounter).Name = strTableName Then
            'Delete TargetTable--must start from scratch
            dbs.TableDefs.Delete (strTableName)
        End If
        nCounter = nCounter + 1
    Loop
    
    
    Set tdf = dbs.CreateTableDef(strTableName)
    For iField = 1 To FIELDS.ROWCOUNT
        fName = FIELDS(iField, "FIELDNAME")
        fType = dbText
        fSize = FIELDS(iField, "LENGTH")
        Set fld1 = tdf.CreateField(fName, fType, fSize)
        fld1.AllowZeroLength = True
        fld1.Required = False
        tdf.FIELDS.Append fld1
        nFieldData(iField, 1) = FIELDS(iField, "OFFSET")
        nFieldData(iField, 2) = FIELDS(iField, "LENGTH")
    Next
    
    'Create the table in the database
    dbs.TableDefs.Append tdf
    dbs.TableDefs.Refresh

    'Open the table in the Database
    '**************************************
    Set rs = dbs.OpenRecordset(strTableName)
        
    'Display Contents of the table
    '**************************************

    'Class this function up a little...
    RetVal = SysCmd(acSysCmdClearStatus)
    RetVal = SysCmd(acSysCmdInitMeter, "Importing " & strTableName & " from SAP...", DATA.ROWCOUNT)

    iField = 1
    nRowCount = FIELDS.ROWCOUNT
    For iField = 1 To nRowCount
        nFieldData(iField, 1) = FIELDS(iField, "OFFSET")
        nFieldData(iField, 2) = FIELDS(iField, "LENGTH")
    Next
    For iRow = 1 To DATA.ROWCOUNT
        
        nTotalRecords = nTotalRecords + 1
        If Second(Now()) <> nCurSec Then ' And nCurRec <> rs.RecordCount Then
            nCurSec = Second(Now())
            nTotalSeconds = nTotalSeconds + 1
            nSecondsLeft = Int(((nTotalSeconds / iRow) * DATA.ROWCOUNT) * ((DATA.ROWCOUNT - iRow) / DATA.ROWCOUNT))
            RetVal = SysCmd(acSysCmdRemoveMeter)
            RetVal = SysCmd(acSysCmdInitMeter, "Importing " & strTableName & " from SAP, " & nSecondsLeft & " seconds remaining. [" & nTotalRecords & " of " & DATA.ROWCOUNT & "]", DATA.ROWCOUNT)
            RetVal = SysCmd(acSysCmdUpdateMeter, iRow)
            RetVal = DoEvents()
        End If

        
    '   Add a new row to the DB
        strRow = DATA(iRow, 1) 'Pull this into a string rather than pull it from DATA each time...
        
        rs.AddNew
        For iField = 1 To nRowCount
           rs.FIELDS(iField - 1).Value = Trim(Mid(strRow, nFieldData(iField, 1) + 1, nFieldData(iField, 2)))
        Next
        rs.Update
     Next
        
    rs.Close
    Close #2
    Set dbs = Nothing
    Set rs = Nothing
    RetVal = SysCmd(acSysCmdRemoveMeter)
End Function

Update:

When the table is so large that is causes overflow errors in the program called by the RFC, the table can be extracted in blocks. This example of the same code incorporates an offset and length to break the table up into manageable blocks that are appended to the table one after the other.

Mike Burnett gets special credit here for creating a need for this updated code and for the help with this programmer's rusty VBA skills. The original function was written in 2004 and the updated version is from 2019.

Option Compare Database


Sub QuickTest()
  Dim a As Boolean
  a = SAP_RFC_READ_TABLE("KNVP", "tblKNVP", "")
End Sub

Function SAP_RFC_READ_TABLE(strSAPTable As String, strTableName As String, strFields As String, Optional strOptions As String = "") As Boolean

'Função para ler as tabelas diretamente do SAP
'Adaptada de http://saplsmw.com/Import_tables_directly_into_Access_from_SAP_using_RFCs
'strSAPTable = Tabela SAP a ser lida Ex: "TACTZ"
'strTableName = Tabela Access (Será apagada e reescrita) Ex: "BASE_TACTZ"
'strFields = Nome dos campos que vão ser lidos, separados por virgula Ex: "BROBJ,ACTVT"
'strOption = Funciona como um where para a leitua. As aspas do exemplo são obrigatórias Ex. "ACTVT = '01'"

    Dim strTemp As String
    
    'Create the database parallel to SAP's . . .
    Dim nCounter As Long, nCurrent As Long
    Dim dbs As dao.Database
    Set dbs = CurrentDb
    Dim tdf As dao.TableDef
    Dim fld1 As dao.Field
    Dim fld2 As dao.Field
    Dim fName As String
    Dim fType As Integer
    Dim fSize As Integer
    Dim nFieldData(999, 2) As Long
    Dim strRow As String
    Dim strFieldnames() As String
    Dim strConvOptions() As String
    Dim FinalRFCQuery As String
    Dim vField As Variant
    Dim j As Integer
    Dim rs As Recordset
    Dim SQL As String
    Dim nCurRec As Long, nCurSec As Long
    Dim isUpdate As Boolean
    Dim strFieldName As String
    Dim nRowCount As Long
    Dim nTotalRecords As Long

    Dim RetVal As Variant, nSecondsLeft As Long, nTotalSeconds As Long
    Dim R3, MyFunc, 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
    
    ' Define the objects to hold the EXPORT parameters
    ' None for RFC_TABLE_READ

    ' Define the objects to hold the TABLES parameters
    ' 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 iRow, iColumn, iStart, iStartRow, iField, iLength As Integer
    
    '**********************************************
    'Create Server object and Setup the connection
    '**********************************************
    
    Dim strSAP_System As String
    Dim strSAP_SystemNumber As String
    Dim strSAP_Client As String
    Dim strSAP_User As String
    Dim strSAP_Password As String
    Dim strSAP_Language As String
    Dim strSAP_ApplicationServer As String
    
    
    '***********************************
    ' Set up an offset and length loop.
    '***********************************
    Const nMaxRowCount = 100000
    Dim nRowSkip
    nRowSkip = 0
    

    nTotalSeconds = 0

    Set R3 = CreateObject("SAP.Functions")
    R3.Connection.System = "P00"
    R3.Connection.SystemNumber = "00"
    R3.Connection.client = "300"
    R3.Connection.User = "your_userid"
    R3.Connection.Password = "your_password"
    R3.Connection.Language = "EN"
    R3.Connection.ApplicationServer = "severhostname.domain.com"

    RetVal = SysCmd(acSysCmdSetStatus, "Connecting to " & strSAP_System & " . . . ")

   If R3.Connection.logon(0, True) <> True Then
       'Couldn't log in silently, try with GUI...
       If R3.Connection.logon(0, False) <> True Then
            Exit Function
       End If
    End If

    '*****************************************************
    'Call RFC function RFC_READ_TABLE
    '*****************************************************
    Set MyFunc = R3.Add("RFC_READ_TABLE")

    ' Set the Objects to the parameter they will return
    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 = strSAPTable
    DELIMITER.Value = vbTab
    NO_DATA = ""
    ROWSKIPS.Value = nRowSkip
    ROWCOUNT.Value = nMaxRowCount
    
    'Quebrando o nome dos campos
    j = 0
    strFieldnames = Split(strFields, ",")
    For Each vField In strFieldnames
        j = j + 1
        FIELDS.Rows.Add
        FIELDS.Value(j, "FIELDNAME") = Trim(UCase(vField))
    Next
    
    'Quebrando Lendo condições Where
    j = 0
    If strOptions <> "" Then
        strConvOptions = Split(strOptions, ",")
        FinalRFCQuery = ""
        For Each vField In strConvOptions
            FinalRFCQuery = FinalRFCQuery & Replace(vField, "=", " EQ ", Compare:=vbTextCompare) & " AND "
        Next
        'Terminando a clausula Where
        FinalRFCQuery = Left(FinalRFCQuery, Len(FinalRFCQuery) - 4)
        OPTIONS.Rows.Add
        OPTIONS.Value(1, 1) = Trim(UCase(FinalRFCQuery))
    End If

    RetVal = SysCmd(acSysCmdSetStatus, "Extracting " & j & " fields from table " & strSAPTable & " in " & strSAP_System & " . . . ")

    Result = MyFunc.CALL

    If Result = True Then
        Set DATA = MyFunc.tables("DATA")
        Set FIELDS = MyFunc.tables("FIELDS")
        Set OPTIONS = MyFunc.tables("OPTIONS")
    Else
        MsgBox MyFunc.EXCEPTION
        R3.Connection.logoff
        Exit Function
    End If

    nTotalColumns = FIELDS.ROWCOUNT
    'Check for existence of TargetTable
    nCounter = 0
    Do While nCounter < dbs.TableDefs.Count
        If dbs.TableDefs(nCounter).Name = strTableName Then
            'Delete TargetTable--must start from scratch
            dbs.TableDefs.Delete (strTableName)
        End If
        nCounter = nCounter + 1
    Loop
    
    
    Set tdf = dbs.CreateTableDef(strTableName)
    For iField = 1 To FIELDS.ROWCOUNT
        fName = FIELDS(iField, "FIELDNAME")
        fType = dbText
        fSize = FIELDS(iField, "LENGTH")
        Set fld1 = tdf.CreateField(fName, fType, fSize)
        fld1.AllowZeroLength = True
        fld1.Required = False
        tdf.FIELDS.Append fld1
        nFieldData(iField, 1) = FIELDS(iField, "OFFSET")
        nFieldData(iField, 2) = FIELDS(iField, "LENGTH")
    Next
    
    'Create the table in the database
    dbs.TableDefs.Append tdf
    dbs.TableDefs.Refresh

    'Open the table in the Database
    '**************************************
    Set rs = dbs.OpenRecordset(strTableName)
        
    'Display Contents of the table
    '**************************************

    'Class this function up a little...
    RetVal = SysCmd(acSysCmdClearStatus)
    RetVal = SysCmd(acSysCmdInitMeter, "Importing " & strTableName & " from SAP...", DATA.ROWCOUNT)

    iField = 1
    nRowCount = FIELDS.ROWCOUNT
    For iField = 1 To nRowCount
        nFieldData(iField, 1) = FIELDS(iField, "OFFSET")
        nFieldData(iField, 2) = FIELDS(iField, "LENGTH")
    Next
    
    Do While DATA.ROWCOUNT > 0
    
        For iRow = 1 To DATA.ROWCOUNT
        
            nTotalRecords = nTotalRecords + 1
            If Second(Now()) <> nCurSec Then ' And nCurRec <> rs.RecordCount Then
                nCurSec = Second(Now())
                nTotalSeconds = nTotalSeconds + 1
                nSecondsLeft = Int(((nTotalSeconds / iRow) * DATA.ROWCOUNT) * ((DATA.ROWCOUNT - iRow) / DATA.ROWCOUNT))
                
                RetVal = SysCmd(acSysCmdRemoveMeter)
                RetVal = SysCmd(acSysCmdInitMeter, "Importing " & strTableName & " from SAP, " & nSecondsLeft & " seconds remaining. [" & nTotalRecords + nRowSkip & " of " & DATA.ROWCOUNT + nRowSkip & "]", DATA.ROWCOUNT)
                RetVal = SysCmd(acSysCmdUpdateMeter, iRow)
                RetVal = DoEvents()
            End If

        
            strRow = DATA(iRow, 1) 'Pull this into a string rather than pull it from DATA each time...
            
            'Add a new row to the table
            rs.AddNew
            For iField = 1 To nRowCount
                rs.FIELDS(iField - 1).Value = Trim(Mid(strRow, nFieldData(iField, 1) + 1, nFieldData(iField, 2)))
            Next
            rs.Update
        Next
        
        '***********************************************************
        ' Check to see if the function should be called again . . .
        '***********************************************************
        If DATA.ROWCOUNT < nMaxRowCount Then
            'There is no need to read again to get a zero value.
            Exit Do
        Else
            'Move the offset by the block size.
            nRowSkip = nRowSkip + nMaxRowCount
        End If
        
        '***********************************************************
        ' Call the function again to get the next block of records.
        '***********************************************************
        ROWSKIPS.Value = nRowSkip
        ROWCOUNT.Value = nMaxRowCount
        MyFunc.Tables("DATA").Rows.RemoveAll 'Special thanks to Mike Burnett
        Result = MyFunc.CALL
        Set DATA = MyFunc.Tables("DATA")
        Set FIELDS = MyFunc.Tables("FIELDS")
        Set OPTIONS = MyFunc.Tables("OPTIONS")
        
    Loop
    
    rs.Close
    Close #2
    Set dbs = Nothing
    Set rs = Nothing
    RetVal = SysCmd(acSysCmdRemoveMeter)
    
    '*****************************************
    ' Log off of the SAP system and clean up.
    '*****************************************
    Set DATA = Nothing
    Set FIELDS = Nothing
    Set OPTIONS = Nothing
    Set MyFunc = Nothing
    R3.Connection.logoff
    Set R3 = Nothing
End Function

Update: Solving the SAPSQL_DATA_LOSS problem

This new error first seen in May of 2023 is caused by where statements being passed into the RFC with compare values that are longer than the length of the field in characters. See the bottom of this article about using RFCs to import table data into Microsoft Excel for more details and for suggestions on how to correct this issue.

Download

This function is included as part of Jimbo's VBA Toolbox which can be downloaded for free. It includes a lot of other great tools written over a 16-year career in data migration.