Mirror an SAP Server Onto a Local Computer Using VBA, RFCs and SQL Server Express

Jimbo's picture

Mirror an SAP serverHaving a mirrored copy of a production SAP server (or a legacy SAP server) can prove immensely useful during an SAP implementation and works wonders for producing extracts with complex joins that can be used to produce load files and to validate loads afterwards. Sadly, not every organization will justify an SLT server or have the willingness to share access to it with key data migration resources.

SAP Replicator is opensource VBA code designed to be run on Microsoft Access to populate a Microsoft SQL Server with the data from an SAP server using RFCs. It initially uses a series of calls to the RFC_READ_TABLE function to take, in small nibbles, a snapshot of SAP tables. The example below was written over a weekend to handle a Material Master data migration project, but code changes can be easily intuited to include other Master Data objects or transactional data where required.

Notes are included in the remarks as to what bits of particularly complex code do. Things like finding a connection string that works and accommodating Master Data numbers that end in letters can be found there.

The SAP_RFC_READ_TABLE VBA function makes another appearance here, but has been heavily modified to reduce traffic on what is likely a production SAP server. Once the initial snapshot is populated with the server data, the deltas can maintain a mirrored copy with fewer than 100 RFC calls per day with processing time on the SAP server taking mere seconds; this can be further reduced by increasing the number of seconds passed to the WaitSeconds() function (see notes in the remarks).

Database Limitations

While SQL Server Express has an absurdly low 10GB size limit for databases, it can still be used for smaller organizations or for larger multinational organizations with some prudent filtering. By extracting only the necessary fields from only the necessary tables, the mirrored data can be maintained without exceeding the threshold. Alternatively, a full Micorosft SQL Server installation can be utilized with SAP Replicator in order to exceed the 10GB database size limitation of SQL Server Express.

The production server for which this code was written has more than eight million Material Masters with some having more than eight hundred pertinent Plant extensions each potentially with dozens of Storage Locations. By filtering out Material Masters and Plant extensions that were unrelated to the project, the mirrored data peaked at just under 10GB and allowed for complex validation and analysis of the data being loaded for the project.

Getting Started

Obtaining a free copy of Microsoft SQL Server Express is accomplished pretty easily with a short Google search; likely, it is the first hit. Getting the software installed on a corporate laptop or virtual desktop is another matter altogether and will not be addressed in this white paper, but the Basic installation is recommended by dint of having been successfully tested with the code below.

Once the SQL Server Express software is installed, be sure to configure it to allow for the software to connect. Start by logging into SQL Server Management Studio (installed separately from SQL Server Express) by connecting to localhost\sqlexpress.
Log into SSMS

Turn on SQL Server authentication by right-clicking on the server name → Properties → Security and then ticking the SQL Server and Windows Authentication mode under "Server Authentication".
Turn on SQL Server authentication

Next, open up port 1433 by launching the SQL Server Configuration Manager and then drilling down to SQL Server Network Configuration → Protocols for SQLEXPRESS → TCP/IP and then setting the TCP Port under "IPALL" (the last entry in the image below) to 1433.
Turn on TCP/IP connections

Now the server can be accessed by the software, but a database to hold the contents of the SAP Server needs to be created. In the SSMS tool, right click on Databases → New Database... In the "New Database" window, type the name of the SAP server and click the OK button.
Create Database

Credentials are required to connect to the SQL Server for this database, so create a new login by clicking on the server name → Security → Logins → New Login. In the "Login - New" window, type in a Login name, add the password and then un-tick the "Enforce password policy" checkbox if the password does not meet the password requirements of the computer.
Create Login

Next, click on "User Mapping" and then tick the database with the name of the SAP server. Under "Database role membership", be sure to tick db_datareader, db_datawriter and db_owner. The db_owner role allows for the software to create and drop tables in the database.
Assign roles

Click on the OK button and the server is ready to use. The instructions work on regular SQL Server as well as SQL Server Express.

Setting up the software

There is very little left to do at this point. Start by creating a folder on the C: drive of the computer where this software will be running and name that folder "c:\Replicator".

Next, create a new Access database and save it as "c:\Replicator\Replicator.accdb". In the database, create a module by clicking Create → Module.

Change the strConnection value at the top of the code to reflect the settings of the recently created database. Be sure to replace the Database, Uid (user ID) and the Pwd (password) values to match.

While not required, it is strongly recommended to embed the RFC user's credentials in the GetR3() function. Without them, the software stops and waits for the user to manually provide credentials every time the connection is dropped; in an organization with a small SAP server that receives infrequent updates, this may not be much of an inconvenience.

Edit the GetFields() function to include all of the desired fields for each of the tables that will be replicated. Note that when the function returns a zero-length string, the SAP_RFC_READ_TABLE_ToAccess function passes no fields to the BAPI which causes it to return all fields in a table.

Save the module as "Replicator". Finally, run the Replicate() sub.

Things to watch out for

If the combined length of the returned row of data from the RFC_READ_TABLE exceeds 512 characters then the BAPI will return an error explaining that the buffer size has been exceeded. If this happens then reduce the number of fields by listing only those required in the GetFields() function.

Occasionally, a library on which the software relies may cause the program to hang; this might be the library that connects to the SAP server or the library that connects to the SQL server. In this event, just End Task msaccess.exe in the Task Manager and launch the software again; it will pick up where it left off.

If the software is unsuccessful at transferring a block of recently changed data to the server and throws and error starting with "ODBC Insert on a linked table...", it may be that the server is full. Look in SSMS at the database by right-clicking on the database and choosing Properties. The "Space Available" value shown by the server is what is left in the current reservation, but if the "Size" is over 20GB then the database is nearly full.
Database properties

Access rightfully throws a warning any time Access attemps to open an unrecognized file. This is a natural response designed to protect users from malicious code and viruses.

This creates a problem because the software uses disposable Access databases created on demand to temporarily hold data downloaded from the SAP server. Each time the software attempts to open one of these disposable Access databases, Access throws this warning and waits for a user interaction.

The simplest way to circumvent this warning is to declare that the "c:\Replicator" folder is a Trusted Location. In Access, click on File → Options → Trust Center → Trusted Locations. In the "Trusted Locations" screen, click the Add new location... button and type in c:\Replicator.

So much of this is recycled code from previous projects and the references associated with the VBA code were added over the last 18 years. Ensuring that these libraries are referenced will prevent the code from throwing errors when delcaring objects that rely on these libraries to exist.

The version of each library isn't necessarily important as this code worked 18 years ago with the libraries available at the time. For best results, try to use the most recent version of any library as these tend to be faster, more secure and less prone to cause errors.

The code

This code is provided here as opensource code; use it as much as you like. It is absolutely free and requires no license for either private or commercial usage.

SAP Replicator includes no warranty whatsoever, implied or expressed, so please be prepared to support it yourself. The programmer is spread pretty thin these days, but support may be available at the Contact Us page.

'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
'*                                                             *
'*     Replicator 1.2 written by Jim Kauffman October 2021     *
'*                                                             *
'*  The Replicator tool is designed to mirror an SAP server to *
'*  a SQL server and then maintain the mirror by automatically *
'*  performing deltas when the data in the SAP server changes. *
'*  It is provided without warranty of any kind, expressed or  *
'*  implied.  Support is sparse, but may be obtained at this   *
'*  address:  http://saplsmw.com/contact                       *
'*                                                             *
'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

Option Compare Database

Dim R3 As Object 'This is the connection that persists as logged in . . .
Const strConnection As String = "Driver={ODBC Driver 13 for SQL Server};Server=sqlserver.domain.int;Database=P01;Uid=replicator;Pwd=Pa$$w0rd;"
'Const strConnection As String = "Driver={SQL Server};Server=localhost;Database=P01;Uid=replicator;Pwd=Pa$$w0rd;"
Private Declare Sub Sleep Lib "kernel32" (ByVal lngMilliSeconds As Long)


Sub Replicate()
    Dim a As Long, strFields As String, strFileName As String, strTableName As String
    Dim nCurrent As Long, nCurrent2 As Long, strCurrent As String
    Dim strCheckDate As String, strCheckTime As String, strNextDate As String, strLastCheckTime As String
    Dim strCheckDateStop As String, strCheckTimeStop As String, isComplete As Boolean
    Dim nWaitSeconds As Long
    
    Dim objDB As adodb.Connection
    Dim objRS As adodb.Recordset
    Dim db As DAO.database, rs As DAO.Recordset, rs2 As DAO.Recordset
    Dim nRecordCount As Long, nRecordCount2 As Long
    
    a = WaitSeconds(5, "Getting started . . .")
    
    
    If Not GetR3(R3) Then
        'Doesn't operate without a connection to SAP...
        Exit Sub
    End If

    
    strFileName = "c:\replicator\SAP_Date.txt"
    strFields = Dir(strFileName)
    If strFields = "" Then
        'Set today's date as the date from which update searches will start.
        strCheckDate = Right("0000" & Year(Now), 4) & Right("00" & Month(Now), 2) & Right("00" & Day(Now), 2)
        strCheckTime = "000000"
        Open strFileName For Output As #1
        Print #1, strCheckDate
        Print #1, strCheckDate
        Close #1
    End If
    
    strFileName = "c:\Replicator\DD03L.accdb"
    strFields = Dir(strFileName)
    If strFields = "" Then 'This table hasn't been extracted.
        'Start by getting the table definitions directly from SAP...
         
        strFields = "TABNAME,FIELDNAME,POSITION,KEYFLAG,ROLLNAME,CHECKTABLE,INTLEN,DATATYPE,LENG"
        strFileName = "c:\Replicator\DD03L.accdb"
        a = SAP_RFC_READ_TABLE_ToAccess("DD03L", strFileName, strFields, "TABNAME LIKE 'M%' OR TABNAME LIKE 'CA%' OR TABNAME LIKE 'T%' OR TABNAME EQ 'INOB' OR TABNAME EQ 'AUSP' OR TABNAME LIKE 'KS%' OR TABNAME LIKE 'KL%' or TABNAME LIKE 'ST%'")
        If DCount("[Name]", "MSysObjects", "[Name] = 'tblDD03L'") = 0 Then
            'First time using this file...
            DoCmd.TransferDatabase acLink, "Microsoft Access", "c:\replicator\DD03L.accdb", acTable, "DD03L", "tblDD03L"
        End If
        a = RemoveTableDuplicates("tblDD03L") 'Just in case...
        
        'These don't change every day.
        a = SyncronizeData("KSML", "")
        a = SyncronizeData("KLAH", "")
        a = SyncronizeData("CABN", "")
        a = SyncronizeData("CABNT", "SPRAS EQ 'E'")
        a = SyncronizeData("CAWN", "")
        a = SyncronizeData("CAWNT", "SPRAS EQ 'E'")
        a = SyncronizeData("T001L", "")
        a = SyncronizeData("T001W", "")
        a = SyncronizeData("T024D", "")
        a = SyncronizeData("T134M", "")
        a = SyncronizeData("T320", "")
        a = SyncronizeData("T438M", "")
        a = SyncronizeData("T460A", "")
    End If
    
    '* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
    '*                                                                   *
    '*  The following loop pulls an initial snapshot of the Master Data  *
    '*  from the associated tables.  Once complete, only incremental     *
    '*  updates as found in the CDHDR table will be added as deltas.     *
    '*  Where the MATNR field exists with letters (instead of only       *
    '*  numbers), the followng line should be "For nCurrent = 1 to 125". *
    '*                                                                   *
    '* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
    
    Do While Not isComplete
StartLoop:
        On Error GoTo ErrorHandler
        Exit Do
        For nCurrent = 0 To 1025
            If nCurrent < 1000 Then
                strCurrent = Right("00" & nCurrent, 3)
            Else
                'This allows for Master Data that ends with letters.  Instead
                'of 0 to 999, use 0 to 1025 to get the 26 letters of the alphabet.
                strCurrent = Chr(65 + (nCurrent - 1000))
            End If
            If Not isAlreadyLoaded("MARA", "select top 1 * from MARA where MATNR like '%" & strCurrent & "'") Then
                a = SyncronizeData("MARA", "MATNR like '%" & strCurrent & "' AND MTART LIKE 'Y%'")
            End If
            If Not isAlreadyLoaded("MAKT", "select top 1 * from MAKT where MATNR like '%" & strCurrent & "'") Then
                a = SyncronizeData("MAKT", "MATNR like '%" & strCurrent & "' AND SPRAS EQ 'E'")
            End If
            If Not isAlreadyLoaded("MARC", "select top 1 * from MARC where MATNR like '%" & strCurrent & "'") Then
                a = SyncronizeData("MARC", "MATNR like '%" & strCurrent & "' AND ( WERKS LIKE '8%' OR WERKS LIKE 'LZ%' OR WERKS LIKE 'CJ%' )")
            End If
            If Not isAlreadyLoaded("MARD", "select top 1 * from MARD where MATNR like '%" & strCurrent & "'") Then
                a = SyncronizeData("MARD", "MATNR like '%" & strCurrent & "' AND ( WERKS LIKE '8%' OR WERKS LIKE 'LZ%' OR WERKS LIKE 'CJ%' )")
            End If
            If Not isAlreadyLoaded("MBEW", "select top 1 * from MBEW where MATNR like '%" & strCurrent & "'") Then
                a = SyncronizeData("MBEW", "MATNR like '%" & strCurrent & "' AND ( BWKEY LIKE '8%' OR BWKEY LIKE 'LZ%' OR BWKEY LIKE 'CJ%' )")
            End If
            If Not isAlreadyLoaded("MVKE", "select top 1 * from MVKE where MATNR like '%" & strCurrent & "'") Then
                a = SyncronizeData("MVKE", "MATNR like '%" & strCurrent & "' AND ( VKORG LIKE '8H%' OR VKORG LIKE 'LZ%' OR VKORG LIKE 'CJ%' )")
            End If
            If Not isAlreadyLoaded("MARM", "select top 1 * from MARM where MATNR like '%" & strCurrent & "'") Then
                a = SyncronizeData("MARM", "MATNR like '%" & strCurrent & "'")
            End If
            If Not isAlreadyLoaded("MLAN", "select top 1 * from MLAN where MATNR like '%" & strCurrent & "'") Then
                a = SyncronizeData("MLAN", "MATNR like '%" & strCurrent & "'")
            End If
            If Not isAlreadyLoaded("MLGN", "select top 1 * from MLGN where MATNR like '%" & strCurrent & "'") Then
                a = SyncronizeData("MLGN", "MATNR like '%" & strCurrent & "'")
            End If
            If Not isAlreadyLoaded("KSSK", "select top 1 * from KSSK where OBJEK like '%" & strCurrent & "'") Then
                a = SyncronizeData("KSSK", "OBJEK like '%" & strCurrent & "' AND KLART IN ('001','023','ZC1','ZC2','ZCM','ZMM')")
            End If
            If Not isAlreadyLoaded("INOB", "select top 1 * from INOB where OBJEK like '%" & strCurrent & "'") Then
                a = SyncronizeData("INOB", "OBJEK like '%" & strCurrent & "' AND KLART IN ('001','023','ZC1','ZC2','ZCM','ZMM') AND OBTAB EQ 'MARA'")
            End If
            If Not isAlreadyLoaded("AUSP", "select top 1 * from AUSP where OBJEK like '%" & strCurrent & "'") Then
                a = SyncronizeData("AUSP", "OBJEK like '%" & strCurrent & "' AND KLART IN ('001','ZC1','ZC2','ZCM','ZMM')")
            End If
            RetVal = DoEvents
        Next
        isComplete = True
        Exit Do
ErrorHandler:
        'Circle back here any time there is an error in this code or the code below.
        isComplete = False
        strFileName = "c:\Replicator\Error.log"
        Open strFileName For Append As #1
        Print #1, Now
        Print #1, Err.Number
        Print #1, Err.Description
        Print #1, Err.Source
        Print #1, "-------------------------------------------------"
        Close #1
        nWaitSeconds = 600
        If Err.Source = "wdtfuncs" Then
            'See if this resolves the problem "System Resources Exceeded."
            'R3.logoff
            Set R3 = Nothing
            If Not GetR3(R3) Then
                'Doesn't operate without a connection to SAP...
                a = WaitSeconds(3600)
                'Exit Sub
            End If
            nWaitSeconds = 300
        End If
        If InStr(Err.Source, "Microsoft") > 0 Then
            'SQL connectivity error? VPN down?
            nWaitSeconds = 600
        End If
        nCurrent = WaitSeconds(nWaitSeconds, Err.Description) 'Sleep for an hour
        Err.Clear
        'Close open tables.
        'Set rs = CurrentDb.OpenRecordset("MSysObjects")
        'Do While Not rs.EOF
        '    If Left(rs.FIELDS("Name").Value, 4) <> "MSys" Then 'Skip system tables
        '        If SysCmd(acSysCmdGetObjectState, rs.FIELDS("Type").Value, rs.FIELDS("Name").Value) <> 0 Then
        '            RetVal = SysCmd(acSysCmdClearStatus, rs.FIELDS("Type").Value, rs.FIELDS("Name").Value)
        '        End If
        '    End If
        '    rs.MoveNext
        'Loop
        'rs.Close
        
        If Not rs2 Is Nothing Then
            'Erroring out while tblCDPOS is open throws a "Permission denied" error when
            'trying to create the new accdb file because the file is still held open.
            rs2.Close
            Set rs2 = Nothing
        End If
        
        Resume StartLoop
    Loop
    
    'Exit Sub
    

    Dim strSkipMaterials As String, strOptions As String, nMaterialCount As Long, strMaterials(999999) As String
    Dim strTouchedMaterials As String, strTouchedObjects As String, nLoopsWithoutFinds As Long
    Dim strCDPOSFilter As String, strMinChangeNumber As String, strMaxChangeNumber As String
    Dim strSkipOBJEKs As String, nOBJEKCount As Long, strOBJEKs(999999) As String
    nWaitSeconds = 3600 'Check once every so often . . .
    
    '* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
    '*                                                             *
    '*  The next lines tease out the deltas from the SAP system.   *
    '*  Chasing down the actual changes in CDHDR and CDPOS are a   *
    '*  bit cumbersome because Classification data is stored in    *
    '*  a particularly cumbersome way therein.                     *
    '*                                                             *
    '* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
    
    Set db = CurrentDb
    
    Dim strTableList(990, 2) As String, nTableListCount As Long
    strTableList(1, 0) = "MATERIAL"
    strTableList(1, 1) = "MARA"
    strTableList(2, 0) = "MATERIAL"
    strTableList(2, 1) = "MARC"
    strTableList(3, 0) = "MATERIAL"
    strTableList(3, 1) = "MARD"
    strTableList(4, 0) = "MATERIAL"
    strTableList(4, 1) = "MVKE"
    strTableList(5, 0) = "MATERIAL"
    strTableList(5, 1) = "MBEW"
    strTableList(6, 0) = "MATERIAL"
    strTableList(6, 1) = "MAKT"
    strTableList(7, 0) = "MATERIAL"
    strTableList(7, 1) = "MARM"
    strTableList(8, 0) = "MATERIAL"
    strTableList(8, 1) = "MLAN"
    strTableList(9, 0) = "MATERIAL"
    strTableList(9, 1) = "MLGN"
    nTableListCount = 9
    
    strFileName = "c:\replicator\SAP_Date.txt"
    Open strFileName For Input As #1
    Line Input #1, strCheckDate
    Line Input #1, strCheckTime
    Close #1
    
    Do While True 'Just keep running until told to stop . . .
        strSkipMaterials = ""
        strSkipOBJEKs = ""

        'Break off a window of time in which to determine which Material Masters to update next.
        strCheckDateStop = strCheckDate
        strCheckTimeStop = Right("000000" & (Val(strCheckTime) + 20000 + (nLoopsWithoutFinds * 10000)), 6)
        Do While Val(strCheckTimeStop) > 235959
            'Start reading the next day.
            strCheckDateStop = AddOneDay(strCheckDateStop)
            strCheckTimeStop = Right("000000" & (Val(strCheckTimeStop) - 240000), 6)
        Loop
        If Val(strCheckTimeStop) > 235900 Then
            'Round up to the last second of the day so we can move on to the next day.
            strCheckTimeStop = "235959"
        End If
        
        '* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
        '*                                                                   *
        '*  The logic below gets the CDHDR entries between a start date and  *
        '*  start time and a stop date and stop time along with all records  *
        '*  that fall on days between the start date and the stop date.      *
        '*                                                                   *
        '* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
        If strCheckDate = strCheckDateStop Then
            strOptions = "OBJECTCLAS IN ( 'MATERIAL', 'CLASSIFY' ) AND " & _
             "( UDATE EQ '" & strCheckDate & "' AND UTIME GE '" & strCheckTime & "' AND UTIME LE '" & strCheckTimeStop & "' )"
        Else
            strOptions = "OBJECTCLAS IN ( 'MATERIAL', 'CLASSIFY' ) AND " & _
             "( " & _
             "( UDATE EQ '" & strCheckDate & "' AND UTIME GE '" & strCheckTime & "' ) " & _
             "OR ( UDATE GT '" & strCheckDate & "' AND UDATE LT '" & strCheckDateStop & "' ) " & _
             "OR ( UDATE EQ '" & strCheckDateStop & "' AND UTIME LE '" & strCheckTimeStop & "' ) " & _
             ")"
        End If
         
        nRecordCount = SAP_RFC_READ_TABLE_ToAccess("CDHDR", "c:\Replicator\CDHDR.accdb", "", strOptions)
        If nRecordCount > 0 Then
            nLoopsWithoutFinds = 0
            nWaitSeconds = 3600 'Assume that this is a slow day.

            If DCount("[Name]", "MSysObjects", "[Name] = 'tblCDHDR'") = 0 Then
                'First time using this file...
                DoCmd.TransferDatabase acLink, "Microsoft Access", "c:\replicator\CDHDR.accdb", acTable, "CDHDR", "tblCDHDR"
            End If
            strOptions = ""
            'strNextDate = ""
            Set rs = db.OpenRecordset("select * from tblCDHDR where OBJECTCLAS = 'MATERIAL' and UDATE = '" & strCheckDate & "'")
            strTouchedMaterials = ""
            strCDPOSFilter = ""
            strMinChangeNumber = ""
            strMaxChangeNumber = ""
            Do While Not rs.EOF
                If strMinChangeNumber = "" Or strMinChangeNumber > rs.FIELDS("CHANGENR").Value Then
                    strMinChangeNumber = rs.FIELDS("CHANGENR").Value
                End If
                If strMaxChangeNumber = "" Or strMaxChangeNumber < rs.FIELDS("CHANGENR").Value Then
                    strMaxChangeNumber = rs.FIELDS("CHANGENR").Value
                End If
                rs.MoveNext
            Loop
            rs.Close
        
            If strMinChangeNumber <> "" Then 'Found some records . . .
                For nCurrent = 1 To nTableListCount
                    strTableList(nCurrent, 2) = ""
                Next
                
                strCDPOSFilter = "OBJECTCLAS = 'MATERIAL' AND ( CHANGENR GE '" & strMinChangeNumber & "' AND CHANGENR LE '" & strMaxChangeNumber & "' )"
                nRecordCount2 = SAP_RFC_READ_TABLE_ToAccess("CDPOS", "c:\Replicator\CDPOS.accdb", "OBJECTCLAS,OBJECTID,CHANGENR,TABNAME,TABKEY", strCDPOSFilter)
                If DCount("[Name]", "MSysObjects", "[Name] = 'tblCDPOS'") = 0 Then
                    'First time using this file...
                    DoCmd.TransferDatabase acLink, "Microsoft Access", "c:\replicator\CDPOS.accdb", acTable, "CDPOS", "tblCDPOS"
                End If
                
                Set rs2 = db.OpenRecordset("select * from tblCDPOS order by OBJECTID, TABNAME")
                Do While Not rs2.EOF
                    'Reduce the length of strOptions for organizations with many Plants and Storage Locations.
                    For nCurrent = 1 To nTableListCount
                        If InStr(rs2.FIELDS("TABNAME").Value, strTableList(nCurrent, 1)) > 0 Then 'Only pull from applicable tables.
                            'Since we're pulling all the records for this table, only include the Material Master number once.
                            strOptions = "MATNR EQ '" & rs2.FIELDS("OBJECTID").Value & "'"
                            If strTableList(nCurrent, 1) = "MARA" Then
                                strOptions = "( " & strOptions & " AND MTART LIKE 'Y%' )"
                            ElseIf strTableList(nCurrent, 1) = "MARC" Then
                                strOptions = "( " & strOptions & " AND WERKS EQ '" & Mid(rs2.FIELDS("TABKEY").Value, 22, 4) & "' )"
                            ElseIf strTableList(nCurrent, 1) = "MARD" Then
                                'strOptions = "( " & strOptions & " AND WERKS EQ '" & Mid(rs2.FIELDS("TABKEY").Value, 22, 4) & "' AND LGORT EQ '" & Mid(rs2.FIELDS("TABKEY").Value, 26, 4) & "' )"
                                strOptions = "( " & strOptions & " AND WERKS EQ '" & Mid(rs2.FIELDS("TABKEY").Value, 22, 4) & "' )"
                            ElseIf strTableList(nCurrent, 1) = "MBEW" Then
                                strOptions = "( " & strOptions & " AND BWKEY EQ '" & Mid(rs2.FIELDS("TABKEY").Value, 22, 4) & "' )"
                            ElseIf strTableList(nCurrent, 1) = "MAKT" Then
                                strOptions = "( " & strOptions & " AND SPRAS EQ 'E' )"
                            End If
                            If InStr(strTableList(nCurrent, 2), strOptions) < 1 Then
                                If strTableList(nCurrent, 2) <> "" Then
                                    strTableList(nCurrent, 2) = strTableList(nCurrent, 2) & " OR "
                                End If
                                strTableList(nCurrent, 2) = strTableList(nCurrent, 2) & strOptions
                            End If
                        End If
                    Next
                    rs2.MoveNext
                    For nCurrent = 1 To nTableListCount
                        'This value can max out at 19000. Watch out for "System Resources Exceeded" error.
                        If Len(strTableList(nCurrent, 2)) > 18000 Or (Len(strTableList(nCurrent, 2)) > 0 And rs2.EOF) Then
                            a = SyncronizeData(strTableList(nCurrent, 1), strTableList(nCurrent, 2))
                            a = WaitSeconds(5, strCheckDate & " " & strCheckTime & ", Updated " & strTableList(nCurrent, 1) & " " & a & " records.")
                            strTableList(nCurrent, 2) = ""  'Start over.  Phew!
                        End If
                    Next
                Loop
                RetVal = DoEvents
                rs2.Close
                Set rs2 = Nothing
            Else
                nLoopsWithoutFinds = nLoopsWithoutFinds + 1
            End If
            Set rs = Nothing
        
            ' Now do the Classification check...
            strOptions = "select * from tblCDHDR where OBJECTCLAS = 'CLASSIFY' and UDATE = '" & strCheckDate & "'"
            Set rs = db.OpenRecordset(strOptions)
            strTouchedObjects = ""
            strOptions = ""
            Do While Not rs.EOF
                If rs.FIELDS("UDATE").Value = strCheckDate Then 'Only one day at a time . . .
                    If InStr(strTouchedObjects, Left(rs.FIELDS("OBJECTID").Value, 18)) < 1 Then
                        'Ensure that we do not update the Material more than once during a loop.
                        strTouchedObjects = strTouchedObjects & Left(rs.FIELDS("OBJECTID").Value, 18)
                        If strOptions <> "" Then
                            strOptions = strOptions & " OR "
                        End If
                        strOptions = strOptions & "CUOBJ EQ '" & Left(rs.FIELDS("OBJECTID").Value, 18) & "'"
                    End If
                End If
                rs.MoveNext
                If Len(strOptions) > 19000 Or (Len(strOptions) > 0 And rs.EOF) Then
                    a = SyncronizeData("INOB", "( " & strOptions & " ) AND OBTAB EQ 'MARA'") 'Classifications
                    strOptions = ""
                    If a > 0 Then
                        Set rs2 = db.OpenRecordset("INOB")
                        Do While Not rs2.EOF
                            If strOptions <> "" Then
                                strOptions = strOptions & " OR "
                            End If
                            strOptions = strOptions & "OBJEK EQ '" & Left(rs2.FIELDS("CUOBJ").Value, 18) & "'"
                            rs2.MoveNext
                        Loop
                        rs2.Close
                        Set rs2 = Nothing
                        a = SyncronizeData("KSSK", "( " & strOptions & " ) AND KLART IN ('001','023','ZC1','ZC2','ZCM','ZMM')") '001 Classifications
                        a = SyncronizeData("AUSP", "( " & strOptions & " ) AND KLART IN ('023','ZC1','ZC2','ZCM','ZMM')") '001 Classifications
                        a = WaitSeconds(10, strCheckDate & " " & strCheckTime)
                    End If
                    strOptions = ""
                End If
            Loop
            rs.Close
            Set rs = Nothing
            
            ' Now determine the date and time to start the next run . . .
            strOptions = "select * from tblCDHDR"
            Set rs = db.OpenRecordset(strOptions)
            Do While Not rs.EOF
                If rs.FIELDS("UDATE").Value > strCheckDate Then
                    'Use some logic to get the next day with activity . . .
                    If rs.FIELDS("UDATE").Value < strNextDate Or strNextDate = "" Then
                        strNextDate = rs.FIELDS("UDATE").Value
                    End If
                Else
                    If rs.FIELDS("UTIME").Value > strCheckTime Then
                        'Start the next check here...
                        strCheckTime = AddOneSecond(rs.FIELDS("UTIME").Value)
                        If ToSAPDate(Now()) < strCheckDate Then
                            nWaitSeconds = 90  ' We can start the next loop more quickly...
                        Else
                            If Val(strCheckTime) - Val(strLastCheckTime) > 4000 Then
                                'We haven't caught up to the server's time yet.
                                nWaitSeconds = 90
                            Else
                                nWaitSeconds = 3600 ' Can relax for 60 minutes.
                            End If
                        End If
                    End If
                End If
                rs.MoveNext
            Loop
            rs.Close
            Set rs = Nothing
            
            
        Else
            nLoopsWithoutFinds = nLoopsWithoutFinds + 1
            nWaitSeconds = 3600 ' It's a slow day...
        End If
        
        'Pick up on the next day if this one is finished...
        If strNextDate > strCheckDate Then
            'The CDHDR has been read to the end of the day; we start the clock
            'at 000000 to ensure no data is lost.
            strCheckDate = strNextDate
            strCheckTime = "000000"
            strNextDate = ""
        Else
            If strLastCheckTime = strCheckTime Then
                'Ensure that the system isn't stuck on one record with
                'a long gap after it...
                strCheckTime = AddOneSecond(strCheckTime)
                nLoopsWithoutFinds = nLoopsWithoutFinds + 1
            Else
                strLastCheckTime = strCheckTime
            End If
        End If
        strFileName = "c:\replicator\SAP_Date.txt"
        Open strFileName For Output As #1
        Print #1, strCheckDate
        Print #1, strCheckTime
        Close #1

        RetVal = DoEvents
        a = WaitSeconds(nWaitSeconds, strCheckDate & " " & strCheckTime)
    Loop
    
    Set db = Nothing
    
End Sub



Function AddOneDay(strDate As String) As String
    Dim dDate As Date
    dDate = DateSerial(Left(strDate, 4), Mid(strDate, 5, 2), Right(strDate, 2))
    dDate = DateAdd("d", 1, dDate)
    AddOneDay = Year(dDate) & Right("00" & Month(dDate), 2) & Right("00" & Day(dDate), 2)
End Function

Function AddOneSecond(strTime) As String
    Dim nHours As Integer, nMinutes As Integer, nSeconds As Integer
    If Val(strTime) < 235959 Then
        nHours = Left(strTime, 2)
        nMinutes = Mid(strTime, 3, 2)
        nSeconds = Right(strTime, 2)
        nSeconds = nSeconds + 1
        If nSeconds > 59 Then
            nSeconds = 0
            nMinutes = nMinutes + 1
            If nMinutes > 59 Then
                nMinutes = 0
                nHours = nHours + 1
            End If
        End If
        AddOneSecond = Right("00" & nHours, 2) & Right("00" & nMinutes, 2) & Right("00" & nSeconds, 2)
    Else
        'Cannot add one second . . .
        AddOneSecond = strTime
    End If
End Function

Function GetR3(ByRef R3 As Object) As Boolean
    
    Set R3 = CreateObject("SAP.Functions")
    '*************************************
    '  Put in your own credentials here.
    '*************************************
    R3.Connection.System = "P01"
    R3.Connection.SystemNumber = "00"
    R3.Connection.client = "100"
    R3.Connection.User = "username"
    R3.Connection.Password = "password"
    R3.Connection.LANGUAGE = "EN"
    R3.Connection.ApplicationServer = "sapserver.domain.int"

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

End Function

Function SyncronizeData(strTableName As String, strOptions As String) As Long
    Dim objDB As adodb.Connection
    Dim objRS As adodb.Recordset
    Dim db As database, rs As Recordset
    Dim strSQLTo As String, strSQLFrom As String, strWhere As String, strUpdateSQL As String
    Dim nRecordCount As Long
    
    nRecordCount = SAP_RFC_READ_TABLE_ToAccess(strTableName, "c:\Replicator\" & strTableName & ".accdb", GetFields(strTableName), strOptions)
    If nRecordCount > 0 Then
        If DCount("[Name]", "MSysObjects", "[Name] = '" & strTableName & "'") = 0 Then
            DoCmd.TransferDatabase acLink, "Microsoft Access", "c:\replicator\" & strTableName & ".accdb", acTable, strTableName, strTableName
        End If
        a = CreateTableSQL(strTableName, False)
        SyncronizeData = TransferDataSQL(strTableName, strTableName)
    End If
    SyncronizeData = nRecordCount
End Function

Function ObjectIsMasterData(strOBJEK As String) As Boolean
    Dim objDB As adodb.Connection
    Dim objRS As adodb.Recordset
    Dim strSQL As String

    RetVal = SysCmd(acSysCmdSetStatus, "Checking " & strOBJEK & "...")

    ObjectIsMasterData = False
    strSQL = "select * from INOB where CUOBJ = '" & strOBJEK & "'"
    Set objDB = New adodb.Connection
    objDB.CommandTimeout = 0
    objDB.ConnectionString = strConnection
    objDB.Open
    Set objRS = New adodb.Recordset
    objRS.Open strSQL, objDB
    Do While Not objRS.EOF
        If objRS.FIELDS("OBTAB").Value = "MARA" Then
            ObjectIsMasterData = True
            Exit Do
        End If
        objRS.MoveNext
    Loop
    objRS.Close
    objDB.Close

    Set objRS = Nothing
    Set objDB = Nothing
    
    RetVal = SysCmd(acSysCmdClearStatus)

End Function



Function GetFields(strTableName As String) As String
    If strTableName = "MARA" Then
        GetFields = "MATNR,ERSDA,ERNAM,LAEDA,AENAM,PSTAT,LVORM,MTART,MATKL,MEINS,LABOR,BRGEW,NTGEW,GEWEI,VOLUM,VOLEH,EAN11,NUMTP,PRDHA,VABME,XCHPF,MSTAE,MSTAV,MSTDE,MSTDV,/BAY0/AACGLO,/BAY0/AAUVP"
    ElseIf strTableName = "MARC" Then
        GetFields = "MATNR,WERKS,PSTAT,MAABC,KZKRI,EKGRP,AUSME,DISMM,DISPO,DISLS,BESKZ,SOBSL,MINBE,EISBE,BSTMI,BSTMA,BSTFE,BSTRF,MABST,SBDKZ,ALTSL,AUSDT,KZBED,FHORI,SSQSS,LADGR,MTVFP,KAUTB,STAWN,HERKL,PRCTR,LOSGR,SOBSK,FRTME,LGPRO,DISGR,KZKUP,LGFSB,SFCPF,MMSTA,MMSTD,NCOST"
    ElseIf strTableName = "MVKE" Then
        GetFields = "MATNR,VKORG,VTWEG,VERSG,BONUS,PROVG,SKTOF,VMSTA,AUMNG,LFMNG,SCMNG,SCHME,VRKME,MTPOS,DWERK,PRODH,PMATN,KONDM,KTGRM,MVGR1,MVGR2,MVGR3,MVGR4,MVGR5,PRAT1,PRAT2,PRAT3,PRAT4,PRAT5,PRAT6,PRAT7,PRAT8,PRAT9,VAVME,RDPRF"
    ElseIf strTableName = "MAKT" Then
        GetFields = "MATNR,SPRAS,MAKTX"
    ElseIf strTableName = "MBEW" Then
        GetFields = "MATNR,BWKEY,BWTAR,LVORM,LBKUM,SALK3,VPRSV,VERPR,STPRS,PEINH,BKLAS,SALKV,VMKUM,VMSAL,VMVPR,VMVER,VMSTP,VMPEI,LPLPR,PSTAT,EKALR,MLAST"
    ElseIf strTableName = "KSSK" Then
        GetFields = "OBJEK,MAFID,KLART,CLINT,ADZHL,ZAEHL,STATU,STDCL"
    ElseIf strTableName = "INOB" Then
        GetFields = "CUOBJ,KLART,OBTAB,OBJEK,CLINT,STATU"
    ElseIf strTableName = "AUSP" Then
        GetFields = "OBJEK,ATINN,ATZHL,MAFID,KLART,ADZHL,ATWRT,ATFLV,ATAWE"
    ElseIf strTableName = "MARD" Then
        GetFields = "MATNR,WERKS,LGORT"
    ElseIf strTableName = "MLGN" Then
        GetFields = "MATNR,LGNUM,LVSME"
    ElseIf strTableName = "MARM" Then
        GetFields = "MATNR,MEINH,UMREZ,UMREN,EANNR,EAN11,NUMTP,LAENG,HOEHE,BREIT,MEABM,VOLUM,VOLEH,BRGEW,GEWEI,MESUB,ATINN"
    ElseIf strTableName = "MLAN" Then
        GetFields = "MATNR,ALAND,TAXM1,TAXM2,TAXM3"
    ElseIf strTableName = "MLGN" Then
        GetFields = "MATNR,LGNUM,LVORM,LGBKZ,LTKZE,LTKZA,LVSME"
    ElseIf strTableName = "KSML" Then
        GetFields = ""
    ElseIf strTableName = "KLAH" Then
        GetFields = "CLINT,KLART,CLASS,STATU"
    ElseIf strTableName = "CABN" Then
        GetFields = "ATINN,ADZHL,ATNAM"
    ElseIf strTableName = "CABNT" Then
        GetFields = "ATINN,SPRAS,ADZHL,ATBEZ"
    ElseIf strTableName = "CAWN" Then
        GetFields = "ATINN,ATZHL,ADZHL,ATWRT,ATCOD,ATSTD"
    ElseIf strTableName = "CAWNT" Then
        GetFields = "ATINN,ATZHL,SPRAS,ADZHL,ATWTB"
    ElseIf strTableName = "T460A" Then
        GetFields = "WERKS,SOBSL,BESKZ"
    End If

End Function

Function WaitSeconds(nSeconds As Long, Optional strMessage As String) As Boolean
    Dim nSecondsPassed As Long
    nSecondsPassed = nSeconds
    Do While nSecondsPassed > 0
        RetVal = SysCmd(acSysCmdSetStatus, "Resting... " & nSecondsPassed & ", " & strMessage)
        nSecondsPassed = nSecondsPassed - 1
        Sleep 1000
        RetVal = DoEvents
        'CurrentData
        
    Loop
    RetVal = SysCmd(acSysCmdClearStatus)
End Function

Function CreateTableSQL(strTableName As String, isOverwrite As Boolean) As Boolean
    Dim rs As DAO.Recordset, strExecute As String, strKey As String, strDrop As String
    Dim nCursec As Integer, nCurrent As Long, strFields As String, nFieldCount As Long
    Dim strFieldType As String
        
    '***********************************************
    '  Find out if this table already exists . . .
    '***********************************************
    If isOverwrite = False Then
        If TableExistsSQL(strTableName) Then
            CreateTableSQL = True
            Exit Function
        End If
    End If
    
    RetVal = SysCmd(acSysCmdSetStatus, "Creating table " & strTableName & " . . . ")
    
    strDrop = "IF OBJECT_ID('" & strTableName & "', 'U') IS NOT NULL drop table dbo." & strTableName & ";"
    strExecute = ""
    strKey = ""
    
    Set rs = CurrentDb.OpenRecordset(strTableName)
    nFieldCount = rs.FIELDS.Count
    For nCurrent = 0 To nFieldCount - 1
        If strFields = "" Then
            strFields = rs.FIELDS(nCurrent).Name
        Else
            strFields = strFields & "," & rs.FIELDS(nCurrent).Name
        End If
    Next
    rs.Close
    
    Set rs = CurrentDb.OpenRecordset("select * from tblDD03L order by POSITION")
    Do While Not rs.EOF
        If UCase(rs.FIELDS("TABNAME").Value) = UCase(strTableName) Then
            If InStr(UCase(strFields), UCase(rs.FIELDS("FIELDNAME").Value)) > 0 Then
                If Len(strExecute) > 0 Then
                    strExecute = strExecute & ","
                End If
                'strExecute = strExecute & "[" & rs.FIELDS("FIELDNAME").Value & "] nvarchar(" & rs.FIELDS("LENG") & ")"
                If rs.FIELDS("DATATYPE").Value = "FLTP" Then
                    strFieldType = "FLOAT(16)"
                Else
                    strFieldType = "varchar(" & rs.FIELDS("LENG") & ")"
                End If
                strExecute = strExecute & "[" & rs.FIELDS("FIELDNAME").Value & "] " & strFieldType
                If rs.FIELDS("KEYFLAG").Value = "X" Then
                    If Len(strKey) > 0 Then
                        strKey = strKey & ","
                    End If
                    strKey = strKey & rs.FIELDS("FIELDNAME").Value
                End If
            End If
        End If
        If nCursec <> Second(Now) Then
            nCursec = Second(Now)
            RetVal = DoEvents
        End If
        rs.MoveNext
    Loop
    rs.Close
    Set rs = Nothing
    
    strExecute = "create table " & strTableName & " (" & strExecute
    If strKey <> "" Then
        strExecute = strExecute & ", Primary Key (" & strKey & ")"
    End If
    strExecute = strExecute & ")"
    Dim database As adodb.Connection
    Set database = New adodb.Connection
    With database
        .ConnectionString = strConnection
        .ConnectionTimeout = 10             'Value is given in seconds.
        .Open
    End With
    If Not database Is Nothing Then
        '... Do work.
        database.Execute strDrop
        database.Execute strExecute
        database.Close          'Make sure to close all database connections.
    End If
    RetVal = SysCmd(acSysCmdClearStatus)
    
    Set database = Nothing
    
End Function


Function TransferDataSQL(strTableNameAccess As String, strTableNameSQL As String) As Boolean
    Dim db As database, rs As Recordset, strSQLTo As String, strSQLFrom As String, strUpdateSet
    Dim strExecute As String, strKeys As String, strKeysInsert As String, strDrop As String, strWhereField As String
    Dim nCurrentRecord As Long
    Dim objDB As adodb.Connection
    Dim objRS As adodb.Recordset
    
    Set db = CurrentDb
    
    Set rs = db.OpenRecordset(strTableNameAccess)
    nFieldCount = rs.FIELDS.Count
    For nCurrent = 0 To nFieldCount - 1
        If strWhereField = "" Then
            strWhereField = rs.FIELDS(nCurrent).Name
        End If
        If strSQLFrom <> "" Then
            strSQLFrom = strSQLFrom & ", "
            strSQLTo = strSQLTo & ", "
            strUpdateSet = strUpdateSet & ", "
        End If
        If IsKey(strTableNameSQL, rs.FIELDS(nCurrent).Name) Then
            If strKeys <> "" Then
                strKeys = strKeys & " AND "
                strKeysInsert = strKeysInsert & " AND "
            End If
            strKeys = strKeys & "toTable.[" & rs.FIELDS(nCurrent).Name & "]=fromTable.[" & rs.FIELDS(nCurrent).Name & "]"
            strKeysInsert = strKeysInsert & strTableNameSQL & ".[" & rs.FIELDS(nCurrent).Name & "]=" & strTableNameAccess & ".[" & rs.FIELDS(nCurrent).Name & "]"
            strWhereField = rs.FIELDS(nCurrent).Name
        End If
        strSQLTo = strSQLTo & "[" & rs.FIELDS(nCurrent).Name & "]"
        strSQLFrom = strSQLFrom & "fromTable" & ".[" & rs.FIELDS(nCurrent).Name & "]"
        strUpdateSet = strUpdateSet & "toTable.[" & rs.FIELDS(nCurrent).Name & "]=fromTable.[" & rs.FIELDS(nCurrent).Name & "]"
    Next
    
    Dim database As adodb.Connection
    Set database = New adodb.Connection
    With database
        .ConnectionString = strConnection
        .ConnectionTimeout = 0             'Value is given in seconds.
        .CommandTimeout = 0
        .Open
    End With
    If Not database Is Nothing Then
        '*  Following line copies the table from the local system to the SQL Database.
        strDrop = "IF OBJECT_ID('tblTemp', 'U') IS NOT NULL drop table dbo.tblTemp;"
        database.Execute strDrop
        'DoCmd.TransferDatabase acExport, "ODBC Database", "ODBC;" & strConnection, _
        '        acTable, strTableNameAccess, "tblTemp", False
        
        'Make an empty copy of the target table to temporarily hold the data.  It's used instead of
        'TransferDatabase acExport becuase it is ten times faster.
        'https://stackoverflow.com/questions/61996764/import-from-txt-ms-access-2013-to-sql-server-2016-slow
        database.Execute "select * into tblTemp from " & strTableNameSQL & " where " & strWhereField & " is null;"
        
        Set objRS = New adodb.Recordset
        objRS.CursorLocation = adUseClient
        objRS.Open "tblTemp", database, adOpenForwardOnly, adLockBatchOptimistic
        
        'Set objRS.ActiveConnection = Nothing
        rs.MoveLast
        rs.MoveFirst
        
        RetVal = SysCmd(acSysCmdInitMeter, "Uploading " & strTableNameSQL & " to SQL Server...", rs.RecordCount)
        
        nCursec = Second(Now())
        Do While Not rs.EOF
            nCurrentRecord = nCurrentRecord + 1
            objRS.AddNew
            For nCurrent = 0 To nFieldCount - 1
                objRS.FIELDS(rs.FIELDS(nCurrent).Name) = rs.FIELDS(nCurrent).Value
            Next
            rs.MoveNext
            'If nCursec <> Second(Now())  Then
            If nCurrentRecord / 500 = Int(nCurrentRecord / 500) Then
                'RetVal = DoEvents
                'Set objRS.ActiveConnection = database
                objRS.UpdateBatch
                'Set objRS.ActiveConnection = Nothing
                RetVal = SysCmd(acSysCmdUpdateMeter, nCurrentRecord)
                RetVal = DoEvents
                'nCursec = Second(Now())
            End If
        Loop
        'Set objRS.ActiveConnection = database
        objRS.UpdateBatch
        objRS.Close
        rs.Close
        db.Close
        Set rs = Nothing
        Set db = Nothing
    

        strExecute = "MERGE " & strTableNameSQL & " as toTable " & _
         "using (select * from tblTemp) as fromTable " & _
         "on ( " & strKeys & " )" & _
         " WHEN MATCHED THEN UPDATE SET " & strUpdateSet & _
         " WHEN NOT MATCHED THEN INSERT (" & strSQLTo & ") VALUES (" & strSQLFrom & ");"
        
        '* Next line copies the data from the Access table (that was just copied to the SQL server).
        database.Execute strExecute

        database.Close          'Make sure to close all database connections.
        
        RetVal = SysCmd(acSysCmdRemoveMeter)

    End If
    
    Set database = Nothing
    Set objRS = Nothing
    Set objDB = Nothing
    
    RetVal = SysCmd(acSysCmdClearStatus)
   
End Function

Function IsKey(strTableName, strFieldName) As Boolean
    Static nKeys As Long, strFields(99999, 2) As String
    Dim db As database, rs As Recordset, nCurrent As Long
    Dim isFound As Boolean
    
    IsKey = False
    isFound = False
    For nCurrent = 1 To nKeys
        If strFields(nCurrent, 0) = strTableName Then
            isFound = True
            If strFields(nCurrent, 1) = strFieldName Then
                If strFields(nCurrent, 2) = "X" Then
                    IsKey = True
                End If
                Exit Function
            End If
        End If
    Next
    
    If isFound Then
        'This field isn't in the table . . .
        Exit Function
    End If
    
    RetVal = SysCmd(acSysCmdSetStatus, "Caching fields for " & strTableName & " . . . ")
    RetVal = DoEvents
    
    Set db = CurrentDb
    Set rs = db.OpenRecordset("tblDD03L") 'No need to sort.
    Do While Not rs.EOF
        If rs.FIELDS("TABNAME").Value = strTableName Then
            nKeys = nKeys + 1
            strFields(nKeys, 0) = rs.FIELDS("TABNAME").Value
            strFields(nKeys, 1) = rs.FIELDS("FIELDNAME").Value
            strFields(nKeys, 2) = rs.FIELDS("KEYFLAG").Value & ""
            If strFields(nKeys, 1) = strFieldName Then
                If strFields(nKeys, 2) = "X" Then
                    IsKey = True
                End If
            End If
        End If
        rs.MoveNext
        If nCursec <> Second(Now) Then
            nCursec = Second(Now)
            RetVal = DoEvents
        End If
    Loop
    rs.Close
    db.Close
    Set rs = Nothing
    Set db = Nothing
    
    RetVal = SysCmd(acSysCmdClearStatus)
    
End Function


Function isAlreadyLoaded(strTableName As String, strSQL As String) As Boolean
    Dim objDB As adodb.Connection
    Dim objRS As adodb.Recordset
    'Dim db As DAO.database, rs As DAO.Recordset
    'Set db = CurrentDb

    RetVal = SysCmd(acSysCmdSetStatus, "Checking " & strSQL & "...")
    RetVal = DoEvents
    
    If TableExistsSQL(strTableName) Then

        Set objDB = New adodb.Connection
        objDB.CommandTimeout = 0
        objDB.ConnectionString = strConnection
        objDB.Open
        Set objRS = New adodb.Recordset
        objRS.Open strSQL, objDB
        Do While Not objRS.EOF
            isAlreadyLoaded = True
            objRS.MoveNext
        Loop
        objRS.Close
        objDB.Close
    

    Else
        isAlreadyLoaded = False
    End If
    
    Set objRS = Nothing
    Set objDB = Nothing
    
    RetVal = DoEvents
    RetVal = SysCmd(acSysCmdClearStatus)
    
End Function

Function TableExistsSQL(strTableName As String) As Boolean
    Dim objDB As adodb.Connection
    Dim objRS As adodb.Recordset
    
    Set objDB = New adodb.Connection
    objDB.CommandTimeout = 0
    objDB.ConnectionString = strConnection
    objDB.Open
    Set objRS = New adodb.Recordset
    objRS.Open "select * from INFORMATION_SCHEMA.tables", objDB
    Do While Not objRS.EOF
        If objRS.FIELDS("TABLE_NAME").Value = strTableName Then
            TableExistsSQL = True
        End If
        objRS.MoveNext
    Loop
    objRS.Close
    objDB.Close
    Set objRS = Nothing
    Set objDB = Nothing
End Function

Function SAP_RFC_READ_TABLE_ToAccess(strSAPTable As String, strFileName As String, strFields As String, Optional ByVal strOptions As String = "") As Long

    Dim strTemp As String
    Dim strOptions2 As String
    strOptions2 = strOptions
    
    '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 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
    
    ' 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
    Dim BAPIRET2 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 = 2000000
    Dim nRowSkip
    nRowSkip = 0
    

    nTotalSeconds = 0

    RetVal = SysCmd(acSysCmdSetStatus, "Connecting to " & R3.Connection.System & " . . . ")

    If R3.Connection.IsConnected < 1 Then
        If Not GetR3(R3) Then
            Exit Function
        End If
    End If
    
    
    nCurrent = R3.Connection.IsConnected

    '*****************************************************
    '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
    FIELDS.Rows.RemoveAll
    If strFields <> "" Then
        strFieldNames = Split(strFields, ",")
        For Each vField In strFieldNames
            j = j + 1
            FIELDS.Rows.Add
            FIELDS.Value(j, "FIELDNAME") = Trim(UCase(vField))
        Next
    Else
        For nCurrent = 1 To 999
            strRow = strRow & ","
        Next
        strFieldNames = Split(strRow, ",")
    End If
    
    'Quebrando Lendo condições Where
    j = 0
    OPTIONS.Rows.RemoveAll
    If strOptions <> "" Then
        stroption = UCase(strOptions)
        'If InStr(strOptions, " OR ") Then
        '    strConvOptions = Split(strOptions, " OR ")
        Do While Len(strOptions) > 0
            For nCurrent = 1 To Len(strOptions)
                If Right(Left(strOptions, nCurrent), 5) = " AND " Then
                    OPTIONS.Rows.Add
                    j = j + 1
                    OPTIONS.Value(j, 1) = Left(strOptions, nCurrent)
                    strOptions = Mid(strOptions, nCurrent + 1, 99999)
                    Exit For
                ElseIf Right(Left(strOptions, nCurrent), 4) = " OR " Then
                    If nCurrent > 35 Then
                        OPTIONS.Rows.Add
                        j = j + 1
                        OPTIONS.Value(j, 1) = Left(strOptions, nCurrent)
                        strOptions = Mid(strOptions, nCurrent + 1, 99999)
                        Exit For
                    End If
                Else
                    If nCurrent = Len(strOptions) Then
                        'This is the last Option.
                        OPTIONS.Rows.Add
                        j = j + 1
                        OPTIONS.Value(j, 1) = strOptions
                        strOptions = ""
                    End If
                End If
            Next
        Loop
    End If

    RetVal = SysCmd(acSysCmdSetStatus, "Extracting from table " & strSAPTable & " to " & strFileName & " . . . ")

    Result = MyFunc.Call

    If Result = True Then
        Set DATA = MyFunc.Tables("DATA")
        Set FIELDS = MyFunc.Tables("FIELDS")
        Set OPTIONS = MyFunc.Tables("OPTIONS")
    Else
        Set BAPIRET2 = MyFunc.Tables("RETURN")
        'MsgBox MyFunc.EXCEPTION
        strOptions = MyFunc.exception
        a = WaitSeconds(100, strOptions)
        Set MyFunc = Nothing
        Set DATA = Nothing
        Set FIELDS = Nothing
        Set OPTIONS = Nothing
        'R3.Connection.logoff
        'Set R3 = Nothing
        RetVal = SysCmd(acSysCmdClearStatus)
        Err.Raise 666, strOptions, "SAP threw a lame error.  Call back to error handler."
        Exit Function
    End If

    nTotalColumns = FIELDS.ROWCOUNT
    
    'Create the Access Database (strFileName).
    '*******************************************
    If Len(Dir(strFileName)) > 0 Then
        Kill strFileName
    End If
    Dim accessApp As Access.Application
    Set accessApp = New Access.Application
    accessApp.DBEngine.CreateDatabase strFileName, DB_LANG_GENERAL
    accessApp.Quit
    Set accessApp = Nothing
    
    Set dbs = OpenDatabase(strFileName)
    Set tdf = dbs.CreateTableDef(strSAPTable)
    nRowCount = FIELDS.ROWCOUNT
    For iField = 1 To nRowCount
        fName = FIELDS(iField, "FIELDNAME")
        fType = dbText
        fSize = FIELDS(iField, "LENGTH") 'nSizes(nCounter) 'fSize = 255
        Set fld1 = tdf.CreateField(fName, fType, fSize)
        fld1.AllowZeroLength = True
        fld1.Required = False
        tdf.FIELDS.Append fld1
        If strFieldName <> "" Then
            strFieldName = strFieldName & ","
        End If
        strFieldNames(iField - 1) = FIELDS(iField, "FIELDNAME") 'Used later . . .
    Next
    dbs.TableDefs.Append tdf
    dbs.TableDefs.Refresh
    dbs.Close
    Set dbs = Nothing
    
    'Open the newly created table in the newly created database.
    '***********************************************************
    Set dbs = OpenDatabase(strFileName)
    Set rs = dbs.OpenRecordset(strSAPTable)
    
    '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")
    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 " & strSAPTable & " from " & R3.Connection.System & " to " & strFileName & ". [" & nTotalRecords & " of " & DATA.ROWCOUNT + nRowSkip & "]", DATA.ROWCOUNT)
                RetVal = SysCmd(acSysCmdUpdateMeter, iRow)
                
                RetVal = DoEvents()
                'rs.Update 'Commit writes each second.
            End If

        
            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(strFieldNames(iField - 1)).Value = Trim(Mid(strRow, nFieldData(iField, 1) + 1, nFieldData(iField, 2)))
            Next
            rs.Update
        Next
        
        '* Free up some memory.
        RetVal = SysCmd(acSysCmdRemoveMeter)
        RetVal = SysCmd(acSysCmdInitMeter, "Cleaning up memory from extracting " & strSAPTable & ". [" & nTotalRecords & " of " & DATA.ROWCOUNT + nRowSkip & "]", DATA.ROWCOUNT)
        RetVal = SysCmd(acSysCmdUpdateMeter, iRow)
        RetVal = DoEvents()
        MyFunc.Tables("DATA").Rows.RemoveAll 'Special thanks to Mike Burnett
        
        '***********************************************************
        ' 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
            'Set the offset to read the next block.
            nRowSkip = nRowSkip + nMaxRowCount
        End If
        
        '***********************************************************
        ' Call the function again to get the next block of records.
        '***********************************************************
        ROWSKIPS.Value = nRowSkip
        ROWCOUNT.Value = nMaxRowCount
        Result = MyFunc.Call
        Set DATA = MyFunc.Tables("DATA")
        Set FIELDS = MyFunc.Tables("FIELDS")
        Set OPTIONS = MyFunc.Tables("OPTIONS")
    Loop
    
    rs.Close
    dbs.Close
    Set rs = Nothing
    Set dbs = 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
    Set QUERY_TABLE = Nothing
    Set DELIMITER = Nothing
    Set NO_DATA = Nothing
    Set ROWSKIPS = Nothing
    Set ROWCOUNT = Nothing
    
    Set dbs = Nothing
    Set tdf = Nothing
    Set fld1 = Nothing
    
    'R3.Connection.logoff
    'Set R3 = Nothing
    SAP_RFC_READ_TABLE_ToAccess = nTotalRecords
End Function

Function RemoveTableDuplicates(strTableName As String) As Boolean

    Dim dbs As DAO.database
    Dim rs As DAO.Recordset
    Dim nCurrent As Long, nFieldCount As Long, nRecordCount As Long
    Dim RetVal As Variant, nCurRec As Long, dnow As Date, nCursec As Long
    Dim nTotalSeconds As Long, nSecondsLeft As Long
    Dim strtest As String, strLastRecord As String, strThisRecord As String
    Dim strSQL As String, nTotalDeleted As Long
    
    Set rs = CurrentDb.OpenRecordset(strTableName)
    nFieldCount = rs.FIELDS.Count
    
    Rem **** Build Query ****
    strSQL = "SELECT * FROM " & strTableName & " ORDER BY "
    For nCurrent = 0 To rs.FIELDS.Count - 1
        strSQL = strSQL & rs.FIELDS(nCurrent).Name
        If nCurrent < rs.FIELDS.Count - 1 Then
            strSQL = strSQL & ", "
        End If
    Next
    strSQL = strSQL & ";"
    rs.Close
    Set rs = CurrentDb.OpenRecordset(strSQL)
    
    nRecordCount = rs.RecordCount

    RetVal = SysCmd(acSysCmdInitMeter, "Removing duplicates from " & strTableName & ". . .", nRecordCount)
    Do While Not rs.EOF
        nCurRec = nCurRec + 1
        If Second(Now()) <> nCursec And nCurRec <> rs.RecordCount Then
            nCursec = Second(Now())
            RetVal = SysCmd(acSysCmdUpdateMeter, nCurRec)
            RetVal = DoEvents()
        End If
        
        strThisRecord = ""
        For nCurrent = 0 To rs.FIELDS.Count - 1
            strThisRecord = strThisRecord & rs.FIELDS(nCurrent).Value
        Next
        If StrComp(strThisRecord, strLastRecord, 0) = 0 Then
            rs.Delete
            nTotalDeleted = nTotalDeleted + 1
            If nTotalDeleted / 1000 = Int(nTotalDeleted / 1000) Then
                rs.Close
                Set rs = CurrentDb.OpenRecordset(strSQL)
                rs.MoveFirst
                'Technically starting over, but not completely.
                nCurRec = nRecordCount - rs.RecordCount
            End If
        End If
        strLastRecord = strThisRecord
        rs.MoveNext
    Loop
    rs.Close
    Set rs = Nothing
    RemoveTableDuplicates = True
    RetVal = SysCmd(acSysCmdRemoveMeter)
End Function

Function ToSAPDate(dDate As Date) As String
    ToSAPDate = Year(dDate) & Right("00" & Month(dDate), 2) & Right("00" & Day(dDate), 2)
End Function

Mirror an SAP serverCredit where it is due

Developing this tool was an exciting learning experience for this humble programmer. I list two very important sources that saved me hours of fighting with a corporate laptop and SQL.

This article and the code written herein required a small crash course on SQL Server's permissions and networking which were provided concisely by this video by Carlo Capello. In this video, Carlo touches on two key issues that were an impasse for hours: SQL Server authentication and TCP Ports and for that, he is showered with special thanks.

Special thanks also to Arshad Ali for this very well written article that allowed for a thourogh understanding of the MERGE command in Microsoft SQL. It allows for a cumbersome combination of UPDATE and INSERT commands using outer joins to be replaced by a clean, eloquent snippet of SQL to do both.

Mirror an SAP server