12-12-2007 8:03 AM
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
03-07-2008 12:31 PM
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
03-14-2008 11:43 AM
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
03-01-2013 4:20 AM
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
03-01-2013 4:57 AM
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)
03-02-2013 7:00 PM
error found. Table name has to be case sensitive. Now it is working.