Update to RFC_READ_TABLE function

Caio Jordão Calisto
[Email redacted]
Hi Jimbo.

First of all, thanks for all your efforts on maintain and share your knowledge regarding the LSWM and SAP Data connections. I'm writing you, and I don't know if it's too late for that, because recently I use your code to integrate ms access and SAP. This code was found in answer to an anonymous question, where you told that you didn't know if the RFC_READ_TABLE accepts more than one Option (Where condition). In fact, it accepts as part of the same string with the END Clause. So, I've updated your code and that's why i'm here, to share with you this update. Feel free to share in your website, if you want to.

I See two ways to improve this code: First, the login box should appear once allowing the programmer to process different tables without having to login again. And the second One, with the update of SAP GUI, the file SAPLogon.INI (Which is the file from where the login window of VBA pulls the information regarding the systems) is no longer used, and it was replaced by an XML file. I'll try to figure out a way to generate a login box with the updated file, and if I achieve it, i'll share with you.

Best Regards:

Option Compare Database

'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'"

Function SAP_RFC_READ_TABLE(strSAPTable As String, strTableName As String, strFields As String, Optional strOptions 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 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

    nTotalSeconds = 0

    Set R3 = CreateObject("SAP.Functions")
    R3.Connection.System = "XXX"
    R3.Connection.SystemNumber = "XX"
    R3.Connection.client = "XXX"
    R3.Connection.User = "XXX"
    R3.Connection.Password = "XXX"
    R3.Connection.Language = "EN"
    R3.Connection.ApplicationServer = "XXX"
    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 = ""
    'Quebrando o nome dos campos
    j = 0
    strFieldnames = Split(strFields, ",")
    For Each vField In strFieldnames
        j = j + 1
        FIELDS.Value(j, "FIELDNAME") = Trim(UCase(vField))
    '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 "

    'Terminando a clausula Where
    FinalRFCQuery = Left(FinalRFCQuery, Len(FinalRFCQuery) - 4)
    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")
        MsgBox MyFunc.EXCEPTION
        Exit Function
    End If
    'Quit the SAP Application
    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
    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")
    'Create the table in the database
    dbs.TableDefs.Append tdf

    '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
    For iField = 1 To nRowCount
        nFieldData(iField, 1) = FIELDS(iField, "OFFSET")
        nFieldData(iField, 2) = FIELDS(iField, "LENGTH")
    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...
        For iField = 1 To nRowCount
           rs.FIELDS(iField - 1).Value = Trim(Mid(strRow, nFieldData(iField, 1) + 1, nFieldData(iField, 2)))
    Close #2
    Set dbs = Nothing
    Set rs = Nothing
    RetVal = SysCmd(acSysCmdRemoveMeter)
End Function
1 month


Jimbo's picture

Hi Caio,

Thanks so much for the great tweak to the where clause; that's going to help out a lot of people. It's clean and neat.

Automatic login can be accomplished by replacing the "XXX" values in the code with actual values (see example below). With a little experimentation, you should be able to coax the right values out of SAPGUI and get them to work with the VBA code.

I haven't seen the new SAPGUI client yet, but I'm not surprised that they decided to move to XML. The old text format for saplogon.ini was so cumbersome and probably not designed by the same Germans who wrote the original code back in the 70's when it was still running on dumb terminals.

If you're using the new SAPGUI client then it sounds like they left in the libraries that make remote function calls possible so that's great news. The format of the saplogon.ini file is completely abstracted from VBA by the SAPGUI client so I do not think it is necessary to access it directly in order to login.

Best regards,

    Set R3 = CreateObject("SAP.Functions")
    R3.Connection.System = "P00"
    R3.Connection.SystemNumber = "00"
    R3.Connection.client = "100"
    R3.Connection.User = "ciao"
    R3.Connection.Password = "password"
    R3.Connection.Language = "EN"
    R3.Connection.ApplicationServer = "sapserver.internalnetwork.int"