Option Compare Database
Option Explicit

Function RFC_READ_TABLE()

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
'**********************************************
Set R3 = CreateObject("SAP.Functions")

R3.Connection.User = "user"
R3.Connection.Password = "1234"
R3.Connection.client = "000"
R3.Connection.ApplicationServer = "10.0.0.0"
R3.Connection.Language = "RU"

If R3.Connection.logon(0, True) <> True Then
   Exit Function
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 = Forms![frmInput]![txtQueryTable]
DELIMITER.Value = Forms![frmInput]![txtDelimiter]'";" ","
NO_DATA = Forms![frmInput]![txtNoData] '"NO"
ROWSKIPS = Forms![frmInput]![txtRowsSkip] "0

If Forms![frmInput]![txtRowCount] <> "" Then
    ROWCOUNT = Forms![frmInput]![txtRowCount]  ' "2"
End If

If Forms![frmInput]![txtOptions] <> "" Then
    OPTIONS.Rows.Add
    OPTIONS.Value(1, "TEXT") = Forms![frmInput]![txtOptions]
End If

If Forms![frmInput]![txtFields] <> "" Then
'   Separate the field into individual fields (input is comma separated)
    Dim vArray As Variant
    vArray = Split(Forms![frmInput]![txtFields], ",")
    Dim vField As Variant
    Dim j As Integer
    For Each vField In vArray
        If vField <> "" Then
            j = j + 1
            FIELDS.Rows.Add
            FIELDS.Value(j, "FIELDNAME") = vField
        End If
    Next
End If
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

'Open the table in the Database
'**************************************
    Dim db As Database
    Dim rs As Recordset
    Dim SQL As String
    Set db = CurrentDb 'OpenDatabase("C:\yourdb.mdb")
    Set rs = db.OpenRecordset("TABLE1")
   
'Display Contents of the table
'**************************************

iField = 1
' For each row of data returned in table DATA
For iRow = 1 To DATA.ROWCOUNT
'   Add a new row to the DB
    rs.AddNew
'   For each field that is returned in table FIELDS
    For iField = 1 To FIELDS.ROWCOUNT
' Determine where in the string the first field is
        iStart = FIELDS(iField, "OFFSET") + 1
iLength = FIELDS(iField, "LENGTH")

' Set the variable vField to be the contents of the current field
'       If the fields at the end of the record are blank, then explicitly set the value
        If iStart > Len(DATA(iRow, "WA")) Then
            vField = Null
Else
            vField = Mid(DATA(iRow, "WA"), iStart, iLength)
End If

' Depending on the current field, put it in the appropriate Access
' DB field
Select Case iField
Case 1
  rs("Field1") = vField
Case 2
  rs("Field2") = vField
  Case 3
  rs("Field3") = vField
  Case 4
  rs("Field4") = vField
End Select
    Next
rs.Update
Next
   
    Set db = Nothing
    Set rs = Nothing
End Function

Function Split(ByVal inp As String, Optional delim As String = ",") As Variant
    ' Chris Rae's VBA Code Archive - http://chrisrae.com/vba
    ' Code written by Chris Rae, 25/5/00
    Dim outarray() As Variant
    Dim arrsize As Integer
    While InStr(inp, delim) > 0
        ReDim Preserve outarray(0 To arrsize) As Variant
        outarray(arrsize) = Left(inp, InStr(inp, delim) - 1)
        inp = Mid(inp, InStr(inp, delim) + 1)
        arrsize = arrsize + 1
    Wend
    ' We still have one element left
    ReDim Preserve outarray(0 To arrsize) As Variant
    outarray(arrsize) = inp
    Split = outarray
End Function

Option Explicit

Function RFC_READ_TABLE()

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
'**********************************************
Set R3 = CreateObject("SAP.Functions")

R3.Connection.User = "..."
R3.Connection.Password = "..."
R3.Connection.client = "..."
R3.Connection.ApplicationServer = "..."
R3.Connection.Language = "RU"
R3.Connection.SapRouter = "..."

If R3.Connection.logon(0, True) <> True Then
   Exit Function
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 = "USR21" ' Forms![frmInput]![txtQueryTable]
DELIMITER.Value = "#" ' Forms![frmInput]![txtDelimiter] '";" ","
NO_DATA = "" ' Forms![frmInput]![txtNoData] '"NO"
ROWSKIPS = 0 ' Forms![frmInput]![txtRowsSkip] "0

'If Forms![frmInput]![txtRowCount] <> "" Then
'    ROWCOUNT = Forms![frmInput]![txtRowCount]  ' "2"
'End If

'If Forms![frmInput]![txtOptions] <> "" Then
'    OPTIONS.Rows.Add
'    OPTIONS.Value(1, "TEXT") = Forms![frmInput]![txtOptions]
'End If

'If Forms![frmInput]![txtFields] <> "" Then
'   Separate the field into individual fields (input is comma separated)
'    Dim vArray As Variant
'    vArray = Split(Forms![frmInput]![txtFields], ",")
'    Dim vField As Variant
'    Dim j As Integer
'    For Each vField In vArray
'        If vField <> "" Then
'            j = j + 1
'            FIELDS.Rows.Add
'            FIELDS.Value(j, "FIELDNAME") = vField
'        End If
'    Next
'End If
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

'Open the table in the Database
'**************************************
    'Dim db As Database
    'Dim rs As Recordset
    'Dim SQL As String
    'Set db = CurrentDb 'OpenDatabase("C:\yourdb.mdb")
    'Set rs = db.OpenRecordset("TABLE1")
   
'Display Contents of the table
'**************************************

iField = 1
' For each row of data returned in table DATA
For iRow = 1 To DATA.ROWCOUNT
    MsgBox DATA(iRow, 1)
'   Add a new row to the DB
    'rs.AddNew
'   For each field that is returned in table FIELDS
    'For iField = 1 To FIELDS.ROWCOUNT
' Determine where in the string the first field is
    '    iStart = FIELDS(iField, "OFFSET") + 1
'iLength = FIELDS(iField, "LENGTH")

' Set the variable vField to be the contents of the current field
'       If the fields at the end of the record are blank, then explicitly set the value
'       If iStart > Len(DATA(iRow, "WA")) Then
  '          vField = Null
'Else
'           vField = Mid(DATA(iRow, "WA"), iStart, iLength)
'End If

' Depending on the current field, put it in the appropriate Access
' DB field
'Select Case iField
'Case 1
'  rs("Field1") = vField
'Case 2
'  rs("Field2") = vField
'  Case 3
'  rs("Field3") = vField
'  Case 4
'  rs("Field4") = vField
'End Select
'   Next
'rs.Update
Next
   
    'Set db = Nothing
    'Set rs = Nothing
End Function

R3.Connection.CodePage = "1504"