Download table data by Microsoft Access

Former Member — Wed, 12 Dec 2007 08:03:21 GMT

I developed the script to which all records of the table were downloaded by the macro of Microsoft Access.

It builds it in according to the following procedures.

1. Create Empty new access file.

2. Create new module.

3. Copy & Paste following VBA code.

4. Select "Tool" -> "Reference setting". Check on to "Microsoft ADO Ext. 2.8 for DDL and Security"

5. Save module.

6. Create new macro. Select "Execute procedure" and input procedure name "testConnect()".

7. Execute macro, and follow the prompt and have FUN!!


'*----------------------------------------------------------------------*
'*  Program Name : SAP Table Data Downloader
'*  Created on : 2007/11/28      Author : Nobubyoshi Kikuchi(ABeam)
'*----------------------------------------------------------------------*
'*  Updated on : yyyy/mm/dd      Author :
'*  Request for change No :
'*  Remarks :
'*----------------------------------------------------------------------*

' Public Constant Definition ======================================================*
Public Const C_RFCNAME_READTABLE        As String = "RFC_READ_TABLE"
Public Const C_RFCPARA_FIELDS           As String = "FIELDS"
Public Const C_RFCPARA_DATA             As String = "DATA"
Public Const C_RFCPARA_COL_FIELDNAME    As String = "FIELDNAME"
Public Const C_RFCPARA_COL_OFFSET       As String = "OFFSET"
Public Const C_RFCPARA_COL_LENGTH       As String = "LENGTH"
Public Const C_RFCPARA_COL_TYPE         As String = "TYPE"
Public Const C_RFCPARA_COL_FIELDTEXT    As String = "FIELDTEXT"
Public Const C_RFCPARA_COL_VALUE        As String = "WA"
Public Const C_RFCPARA_QUERY_TABLE      As String = "QUERY_TABLE"
Public Const C_RFCPARA_DELIMITER        As String = "DELIMITER"
Public Const C_RFCPARA_NO_DATA          As String = "NO_DATA"
Public Const C_RFCPARA_ROWSKIPS         As String = "ROWSKIPS"
Public Const C_RFCPARA_ROWCOUNT         As String = "ROWCOUNT"
Public Const C_PROGRESS_MSG_01          As String = "Creating SAP Connection (1/5)"
Public Const C_PROGRESS_MSG_02          As String = "Getting table fields information (2/5)"
Public Const C_PROGRESS_MSG_03          As String = "Creating table at MS-Access (3/5)"
Public Const C_PROGRESS_MSG_04          As String = "Reading table data (4/5)"
Public Const C_PROGRESS_MSG_05          As String = "Appending data (5/5)"
Public Const C_PROGRESS_MSG_99          As String = " "
Public Const C_SAP_FUNCTION_CLASS       As String = "SAP.Functions"


'*&---------------------------------------------------------------------*
'*&      testConnect
'*&---------------------------------------------------------------------*
'*       This function
'*----------------------------------------------------------------------*
'*       <Non paramente>
'*----------------------------------------------------------------------*
Public Function testConnect()

    Dim sTableName As String
    
    sTableName = InputBox("Import table name")

    createReadTable (sTableName)

End Function

'*&---------------------------------------------------------------------*
'*&      createReadTable
'*&---------------------------------------------------------------------*
'*       1.Connect to SAP
'*       2.Get table fileds information
'*       3.Create table in MS-Access
'*       4.Read table data from SAP table
'*       5.Append data to MS-Access table
'*----------------------------------------------------------------------*
'*       -->sTableName      Read table name
'*----------------------------------------------------------------------*
Public Function createReadTable(sTableName As String)

   On Error GoTo eHandler

' Data Definition ======================================================*
    
    Dim oSAP            As Object           'SAP object
    Dim oConnection     As Object           'SAP Connection object
    Dim oFields         As Collection       'Table fields collection
    Dim oData           As Collection       'Table data collection

    Set oFields = New Collection
    Set oData = New Collection
    
' Process ==============================================================*

    'Check table name
    If sTableName = Empty Then
        MsgBox "Please input table name"
        Exit Function
    End If

    'Create SAP connection
    SysCmd acSysCmdSetStatus, C_PROGRESS_MSG_01
    If createConnection(oSAP, oConnection) = False Then
        Exit Function
    End If

    'Get table fields
    SysCmd acSysCmdSetStatus, C_PROGRESS_MSG_02
    If getTableFields(oSAP, oFields, sTableName) = False Then
        Exit Function
    End If

    'Create table at MS-Access
    SysCmd acSysCmdSetStatus, C_PROGRESS_MSG_03
    If createTable(oFields, sTableName) = False Then
        Exit Function
    End If

    'Read table data
    SysCmd acSysCmdSetStatus, C_PROGRESS_MSG_04
    If readTableData(oSAP, oFields, sTableName, oData) = False Then
        Exit Function
    End If

    'Append data
    SysCmd acSysCmdSetStatus, C_PROGRESS_MSG_05
    If appendData(oFields, oData, sTableName) = False Then
        Exit Function
    End If

    SysCmd acSysCmdSetStatus, C_PROGRESS_MSG_99
    
' Terminate ===========================================================*
    Set oFields = Nothing
    Set oData = Nothing
    Set oConnection = Nothing
    Set oSAP = Nothing
    
    Exit Function

eHandler:
    MsgBox "System Error : " & Err.Number & " " & Err.Description & "(" & Err.Source & ")"
    Exit Function
End Function

'*&---------------------------------------------------------------------*
'*&      createConnection
'*&---------------------------------------------------------------------*
'*       Connect to SAP (Not Silent Logon)
'*----------------------------------------------------------------------*
'*       <--oSAP            SAP object
'*       <--oConnection     Connection object
'*----------------------------------------------------------------------*
Private Function createConnection(oSAP As Object, oConnection As Object) As Boolean

    'Set return value
    createConnection = False

    'Create SAP instance
    Set oSAP = CreateObject(C_SAP_FUNCTION_CLASS)
    'Create SAP connection
    Set oConnection = oSAP.Connection

    'Logon information(Using silent logon)
    'oConnection.Applicationserver = "XXX.XXX.XXX.XXX"
    'oConnection.Client = "XXX"
    'oConnection.user = "XXXXXXXXX"
    'oConnection.language = "J"
    'oConnection.password = "XXXXXXX"
    
    'SAP logon (if you want silent logon, change FALSE to TRUE)
    If oConnection.logon(0, False) <> True Then
        MsgBox "Logon failure"
        Exit Function
    End If
    
    'Set return value
    createConnection = True
    
End Function

'*&---------------------------------------------------------------------*
'*&      getTableFields
'*&---------------------------------------------------------------------*
'*       Get table fields information
'*----------------------------------------------------------------------*
'*       -->oSAP            SAP object
'*       <--oFields         Table fields information
'*       -->sTableName      Read table name
'*----------------------------------------------------------------------*
Private Function getTableFields(oSAP As Object, oFields As Collection, sTableName As String) As Boolean

    'Set return value
    getTableFields = False

' Data Definition ======================================================*
    Dim oFunctionmodule As Object       'SAP Function module object
    Dim oTempFields     As Object       'Temporary object
    Dim row             As Object       'Table row object

' Process ==============================================================*
    'Create remote function module instance
    Set oFunctionmodule = oSAP.Add(C_RFCNAME_READTABLE)
    
    'Set function module parameters
    oFunctionmodule.exports(C_RFCPARA_QUERY_TABLE) = sTableName
    oFunctionmodule.exports(C_RFCPARA_DELIMITER) = ""
    oFunctionmodule.exports(C_RFCPARA_NO_DATA) = "X"
    oFunctionmodule.exports(C_RFCPARA_ROWSKIPS) = 0
    oFunctionmodule.exports(C_RFCPARA_ROWCOUNT) = 0
    
    'Call remote function modele
    oFunctionmodule.Call
    If oFunctionmodule.Exception <> "" Then
        MsgBox ("Error of function module call:" & oFunctionmodule.Exception)
        Exit Function
    End If
    
    'Get table fields information
    Set oTempFields = oFunctionmodule.Tables(C_RFCPARA_FIELDS)
    For Each row In oTempFields.Rows
        Set oField = New Collection
        oField.Add Item:=row.Value(C_RFCPARA_COL_FIELDNAME), Key:=C_RFCPARA_COL_FIELDNAME
        oField.Add Item:=row.Value(C_RFCPARA_COL_OFFSET), Key:=C_RFCPARA_COL_OFFSET
        oField.Add Item:=row.Value(C_RFCPARA_COL_LENGTH), Key:=C_RFCPARA_COL_LENGTH
        oField.Add Item:=row.Value(C_RFCPARA_COL_TYPE), Key:=C_RFCPARA_COL_TYPE
        oField.Add Item:=row.Value(C_RFCPARA_COL_FIELDTEXT), Key:=C_RFCPARA_COL_FIELDTEXT
        oFields.Add oField
    Next row

' Terminate ===========================================================*
    Set oTempFields = Nothing

    'Set return value
    getTableFields = True

End Function

'*&---------------------------------------------------------------------*
'*&      createTable
'*&---------------------------------------------------------------------*
'*       Create table in MS-Access
'*----------------------------------------------------------------------*
'*       -->oFields         Table fields information
'*       -->sTableName      Read table name
'*----------------------------------------------------------------------*
Private Function createTable(oFields As Collection, sTableName As String) As Boolean

    'Set return value
    createTable = False

' Data Definition ======================================================*
    Dim catalog         As ADOX.catalog     'Catalog object
    Dim table           As ADOX.table       'Table object
    Dim row             As Collection       'Table row object
    
' Process ==============================================================*
    'Create and Activetion current project instance
    Set catalog = New ADOX.catalog
    catalog.ActiveConnection = CurrentProject.Connection

    'Clear import table
    For Each table In catalog.Tables
        If sTableName = table.Name Then
            catalog.Tables.Delete sTableName
        End If
    Next table
    Set table = Nothing

    'Create table instance
    Set table = New ADOX.table
    table.Name = sTableName
    
    'Define table fileds
    For Each row In oFields
               
        'Append columns by types
        Select Case row.Item(C_RFCPARA_COL_TYPE)
            Case "C"    'Char
                table.Columns.Append row.Item(C_RFCPARA_COL_FIELDNAME), adVarWChar
            Case "D", "T"   'Date and Time
                table.Columns.Append row.Item(C_RFCPARA_COL_FIELDNAME), adVarWChar
            Case "P"    '
                table.Columns.Append row.Item(C_RFCPARA_COL_FIELDNAME), adDouble
            Case Else
                table.Columns.Append row.Item(C_RFCPARA_COL_FIELDNAME), adVarWChar
        End Select
        
        'Set nullable attribute
        table.Columns(row.Item(C_RFCPARA_COL_FIELDNAME)).Attributes = adColNullable
        
    Next row
    
    'Append table to catalog
    catalog.Tables.Append table
    
' Terminate ===========================================================*
    Set catalog = Nothing
    Set table = Nothing

    'Set return value
    createTable = True

End Function

'*&---------------------------------------------------------------------*
'*&      readTableData
'*&---------------------------------------------------------------------*
'*       Read SAP table data
'*----------------------------------------------------------------------*
'*       -->oSAP            SAP object
'*       -->oFields         Table fields information
'*       -->sTableName      Read table name
'*       <--oData           Read table data
'*----------------------------------------------------------------------*
Private Function readTableData(oSAP As Object, oFields As Collection, sTableName As String, oData As Collection) As Boolean

    'Set return value
    readTableData = False

' Data Definition ======================================================*
    Dim iLength         As Integer
    Dim row             As Collection   'Table row object
    Dim oFieldsTable    As Object
    Dim oFunctionmodule As Object       'SAP Function module object

    Set oFunctionmodule = Nothing

' Process ==============================================================*
    'Create remote function module instance
    Set oFunctionmodule = oSAP.Add(C_RFCNAME_READTABLE)
    
    'Set function module parameters
    oFunctionmodule.exports(C_RFCPARA_QUERY_TABLE) = sTableName
    oFunctionmodule.exports(C_RFCPARA_DELIMITER) = ""
    oFunctionmodule.exports(C_RFCPARA_NO_DATA) = ""     'I want data!!
    oFunctionmodule.exports(C_RFCPARA_ROWSKIPS) = 0
    oFunctionmodule.exports(C_RFCPARA_ROWCOUNT) = 0

    'Create FIELDS table parameter object
    Set oFieldsTable = oFunctionmodule.Tables(C_RFCPARA_FIELDS)
    
    'Initialize
    oFieldsTable.FreeTable
    iLength = 0
        
    'Set import parameter and Call function
    For Each row In oFields

        'Calls every 512 bytes (The limit of RFC_READ_TABLE)
        iLength = iLength + row.Item(C_RFCPARA_COL_LENGTH)
        If iLength <= 512 Then
        
            oFieldsTable.Rows.Add
            oFieldsTable(oFieldsTable.RowCount, C_RFCPARA_COL_FIELDNAME) = row.Item(C_RFCPARA_COL_FIELDNAME)
        
        Else
            'Call remote function module
            If callFunction(oFunctionmodule, oFieldsTable, oData) = False Then
                Exit Function
            End If
            oFieldsTable.FreeTable
            iLength = row.Item(C_RFCPARA_COL_LENGTH)
            oFieldsTable.Rows.Add
            oFieldsTable(oFieldsTable.RowCount, C_RFCPARA_COL_FIELDNAME) = row.Item(C_RFCPARA_COL_FIELDNAME)
        End If

    Next row

    'Call remote function module
    If callFunction(oFunctionmodule, oFieldsTable, oData) = False Then
        Exit Function
    End If
    
    'Set return value
    readTableData = True


End Function

'*&---------------------------------------------------------------------*
'*&      callFunction
'*&---------------------------------------------------------------------*
'*       Call remote function module (RFC_READ_TABLE)
'*----------------------------------------------------------------------*
'*       -->oFunctionmodule RFC module object
'*       -->oFields         Table fields information
'*       <--oData           Read table data
'*----------------------------------------------------------------------*
Private Function callFunction(oFunctionmodule As Object, oFieldsTable As Object, oData As Collection) As Boolean

    'Set return value
    callFunction = False

' Data Definition ======================================================*
    Dim row         As Collection
    Dim oDataTable  As Object
    Dim oDataRow    As Object
    Dim oField      As Object

' Process ==============================================================*

    'Call function
    oFunctionmodule.Call
    If oFunctionmodule.Exception <> "" Then
        MsgBox ("Error of function module call:" & oFunctionmodule.Exception)
        Exit Function
    End If

    'Get export parameter "DATA"
    Set oDataTable = oFunctionmodule.Tables(C_RFCPARA_DATA)
    
    'In the case of the 1st call
    If oData.Count = 0 Then
    
        'Read data and Add to Collection object
        For Each oDataRow In oDataTable.Rows
            Set row = New Collection
        
            For Each oField In oFieldsTable.Rows
                row.Add Item:=Trim(Mid(oDataRow.Value(C_RFCPARA_COL_VALUE), CInt(oField.Value(C_RFCPARA_COL_OFFSET)) + 1, CInt(oField.Value(C_RFCPARA_COL_LENGTH)))), _
                        Key:=oField.Value(C_RFCPARA_COL_FIELDNAME)
            Next oField
            
            oData.Add Item:=row, Key:=CStr(oData.Count)
                        
        Next oDataRow
        
    Else
        'Read data and Update to Collection object
        For Each oDataRow In oDataTable.Rows
            Set row = oData.Item(CStr(oDataRow.Index - 1))
        
            For Each oField In oFieldsTable.Rows
                row.Add Item:=Trim(Mid(oDataRow.Value(C_RFCPARA_COL_VALUE), CInt(oField.Value(C_RFCPARA_COL_OFFSET)) + 1, CInt(oField.Value(C_RFCPARA_COL_LENGTH)))), _
                        Key:=oField.Value(C_RFCPARA_COL_FIELDNAME)
            Next oField

        Next oDataRow
    End If
    
' Terminate ===========================================================*
    oDataTable.FreeTable

    'Set return value
    callFunction = True

End Function

'*&---------------------------------------------------------------------*
'*&      appendData
'*&---------------------------------------------------------------------*
'*       Append data to MS-Access table
'*----------------------------------------------------------------------*
'*       -->oFields         Table fields information
'*       -->oData           Read table data
'*       -->sTableName      Read table name
'*----------------------------------------------------------------------*
Private Function appendData(oFields As Collection, oData As Collection, sTableName As String) As Boolean

    On Error GoTo eHandler
    
    'Set return value
    appendData = False

' Data Definition ======================================================*
    Dim db              As DAO.Database     'My Database
    Dim recordset       As DAO.recordset    'Read records set
    Dim row             As Collection
    Dim field           As Collection
    
' Process ==============================================================*
    'Create DB instance and table recordset
    Set db = CurrentDb()
    Set recordset = db.OpenRecordset(sTableName, dbOpenDynaset)

    For Each row In oData
        recordset.AddNew
            For Each field In oFields
                recordset.Fields(field.Item(C_RFCPARA_COL_FIELDNAME)) = row.Item(field.Item(C_RFCPARA_COL_FIELDNAME))
            Next field
        recordset.Update
    Next row
    
' Terminate ===========================================================*
    Set recordset = Nothing
    Set db = Nothing

    'Set return value
    appendData = True

    Exit Function

eHandler:
    'Not appear an error even when the type of a table column differs from the type of reading.
    If Err.Number = 3421 Then
        Resume Next
    Else
        MsgBox "System Error : " & Err.Number & " " & Err.Description
    End If

End Function

Re: Download table data by Microsoft Access

Former Member — Fri, 07 Mar 2008 12:31:03 GMT

I haven't gotten Nobubyoshi's code to work yet, but I wanted to mention something to everyone who tries. For whatever reason when I paste the code into my module there are three sets of comparators missing from the code. I believe they are all '<>' (not equal to). They are easy to find. They are colored red in my code window.

Thanks for sharing. I am sure we will get this up and running soon.

Ben

Edit:

They were removed from here too!

Test:

Equal: =

Not Equal: <>

Greater Than: >

Less Than: <

Equal To or Less Than: <=

Equal To or Greater Than: >=

Edited by: Ben Rhoads on Mar 7, 2008 2:40 PM

Re: Download table data by Microsoft Access

Former Member — Fri, 14 Mar 2008 11:43:58 GMT

Thanks for sharing this code. We got it all working and even added in some table filtering options. This saved us a bunch of work.

Ben

Re: Download table data by Microsoft Access

Former Member — Fri, 01 Mar 2013 04:20:56 GMT

I'm getting errror "Error of function module call:SYSTEM_FAILURE" when executing "If callFunction(oFunctionmodule, oFieldsTable, oData)" in function readTableData().

Connection is working also the script already pulled the column names for the table into Access but not the tabledata.

Any ideas?

Thanks

Re: Download table data by Microsoft Access

Former Member — Fri, 01 Mar 2013 04:57:12 GMT

This is the information according to the dump caused:

Error: CX_SY_ASSIGN_CAST_UNKNOWN_TYPE

The specified type Typ "agr_1251" is unknown.

code: ASSIGN WORK TO <WA> CASTING TYPE (QUERY_TABLE)

Re: Download table data by Microsoft Access

Former Member — Sat, 02 Mar 2013 19:00:30 GMT

error found. Table name has to be case sensitive. Now it is working.

topic Download table data by Microsoft Access in Application Development and Automation Discussions

Download table data by Microsoft Access

Re: Download table data by Microsoft Access

Re: Download table data by Microsoft Access

Re: Download table data by Microsoft Access

Re: Download table data by Microsoft Access

Re: Download table data by Microsoft Access