Extract data from SAP into MS Access 2003 database
Applies to: SAP
Summary
The article presents how to create a tool to read data from SAP tables into MS Access database.
Author: Sergiu Iatco
Created on: 21 June 2012
- How to create modules as functions
- How to create macros
- How to use
- How to use ADMIN
- How to use TABNAME
- How to create DD03L table
- How to fill DD03L table and choose fields
- How to create the table into which to insert records
- How to insert data from SAP according to structure and selection
- How to clean status bar
- How to delete data from table(s)
- How to secure data from ADMIN table
- How to use data
- Weaknesses
- FUNCTIONS
- Related Content
- Copyright
The article describes how to create a multifunctional tool to read data from transparent tables of SAP into MS Access database. Basic knowledge of MS Access 2003 and ABAP are necessary. The tool is created in plain VBA with basic GUI in order to keep it simple leaving enough room for further own adjustments. Once the tool is created you may use it for any table, with one table or many tables processed consecutively, you may define selections, you may define the way of logon dialog or silent, you may define if the message should pop-up or issued only on status bar, etc. With additional knowledge of VBA you may redesign it to your specific need. The main purpose of the tool is to save time instead of storing data into external files and converting each time to the same structure but with different content. I consider that processing of data with this tool could be especially helpful during implementation projects and testing of reports when checking and rechecking of results takes lot of time.
You have to follow step by step instructions to create functions and macros with copy-paste, and then you are ready to run macros to create administration tables and definitions for tables to retrieve data from.
How to create modules as functions
First of all you to have to create a MS Access file. Name it RFC_SAP_SE16.mdb
In tab Objects press 
then press 
Delete any proposed code.
Go to chapter Function CreateADMIN() and copy the code from Function Function CreateADMIN()} to End Function. Paste the code.
Press 
. In dialog window Save As in Module Name insert {00 – CreateADMIN}.
Press 
.
Repeat this step for following functions:
CreateADMIN() | 00 - CreateADMIN |
CreateTABNAME() | 01 – CreateTABNAME |
CreateDD03L() | 02 - CreateDD03L |
fillDD03L() | 03 - FillDD03L |
CreateTableAsDD03L() | 04 - CreateTableAsDD003L |
ReadTableAsDD03L() | 05 - ReadTableAsDD03 |
DeleteAsTabname() | 06 – DeleteAsTabname |
RRemoveMeter() | 07 – RemoveMeter |
How to create macros
In tab Objects press 
.then press 
.
In Action drop list select RunCode
In Function Name press 
In window Expression Builder, in Functions frame select CreateADMIN.
Press 
.
Press 
. In window Save As in Macro Name insert 00 Create 00ADMIN.
Press 
.
Created macro will look as shown below.
Repeat this step for following macros starting with second row:
00 Create 00ADMIN | 00 - CreateADMIN | CreateADMIN() |
01 Create 01TABNAME} | 01 – CreateTABNAME | CreateTABNAME() |
02 Create DD03L | 02 - CreateDD03L | CreateDD03L() |
03 Fill DD03L | 03 - FillDD03L | fillDD03L() |
04 CreateTableAs DD03L | 04 - CreateTableAsDD003L | CreateTableAsDD03L() |
05 ReadTableAs DD03L | 05 - ReadTableAsDD03 | ReadTableAsDD03L() |
06 DeleteAsTabnameDeleteAllData | 06 – DeleteAsTabname | DeleteAsTabname() |
07 RRemoveMeter | 07 – RemoveMeter | RRemoveMeter() |
Created macros will look as shown below:
To run you press 
.
You may create a special toolbar for you macros to run them without going to tab 
.
From Menu select View/Toolbars/Customize/New. Then drag and drop macros on toolbar.
The scope of each macro is explained in next chapters.
How to use
How to use ADMIN
Run macro
to create table 00ADMIN.
In tab Object select Tables and the open table 00ADMIN.
Fill in table 00ADMIN values in fields as explained bellow.
Field | Value |
CNT_STR_APPLN_SRVR | IP of SAP server |
CNT_STR_CLIENT | Client |
CNT_STR_PWD | Password |
CNT_STR_SYS_NUM | System Number |
CNT_STR_SYSTEM | System ID |
CNT_STR_USR | User |
CNT_STR_LOGON_LANG | Logon Language |
MessageOn | [X] – Pop-up dialog message [ ] – Status bar Messages |
Active | [..] – Dialog Logon [X] – User and password is taken automatically from 00ADMIN table |
- In table 00ADMIN you may define logon parameters for different systems. To set the default system set Active = “X”.
- You must set only one system as default. When more then one records has Active = “X” the execution is terminated.
- In case no record has Active = “X”, you will have to logon manually.
Having logon definitions of more then one system is useful when you have to move tests from development system to quality assurance and then to productive.
How to use TABNAME
Run macro 
to create table 01TABNAME
In tab Object select Tables and the open table 01TABNAME.
Fill in table 00TABNAME values in fields as explained bellow.
Tabname | SAP R/3 to retrieve table from |
Options | Selection using ABAP syntax. Do not insert dot at the end. |
CreateDD03L | To create structure of table DD03L |
FillDD03L | To fill structure with content |
CreateAsDD03L | To create table according to definitions from DD03L |
ReadAsDD03L | To retrieve data from table in filled in field Tabname when you run macro {05 ReadTableAs DD03L } |
ReadAsSQLon | When you read more then 100 000 records you may try to improve performance by checking this field |
DeleteAllData | Content of table is deleted when you run macro {06 DeleteAsTabnameDeleteAllData } |
Example for Table T002 with selection of spras less or equal ‘9’
How to create DD03L table
Run macro 
Table with name DD03L_’Tabname’ is created in this case DD03L_T002.
How to fill DD03L table and choose fields
Run macro 
. Table DD03L_T002 is filled with data that correspond to structure of the table similar to transaction SE11. Select column {Order} and press 
to get the right order.
You have to select fields to be retrieved by checking them in column Choose_Field.
The maximum length of all selected fields is 512 characters this is a restriction of ABAP function RFC_READ_TABLE (transaction SE37)
How to create the table into which to insert records
Run macro 
. Table with selected fields is created.
At this stage you should have following tables:
How to insert data from SAP according to structure and selection
Run macro 
. Table T002 is filled with data retrieved from SAP R/3 according to Options indicated in table 01TABNAME.
When a macro runs and you move to another application the MS Access window may look freezing but you have to know that it is still running in background so you may leave until it finished. To take a look inside you may pause a running VBA code pressing on keyboard [Fn]+[Break] and decide whether to continue or stop the code.
Only most important errors are managed with dialog messages. In case of any other errors application will issue VBA messages and Debug option to find details inside of the code.
Application calls function ‘RFC_READ_TABLE’, therefore to find ABAP specific error you have to run in SAP transaction SE37 with RFC_READ_TABLE.
I suggest starting with a very simple table. Once you get confident of the results you may increase complexity.
The example presented shows how to work with one table based on single row in 01TABNAME.
The tool allows you to insert many rows with deferent tables or same table in 01TABNAME. All rows will be processed sequentially. After you defined the structure and selected the fields to work with you will need only columns ReadAsDD03l and DeleteAllData. To refresh data you have to delete them first with macro 06 DeleteAsTabnameDeleteAllData because records are appended. In bellow example from T002 tool will retrieve data according to two Options.
How to clean status bar
Sometimes information on bottom status bar is not cleaned, to clean it run macro
How to delete data from table(s)
Run macro 
After you have defined structure of tables and tables in order to avoid overwritten in table I suggest unchecking in table 01TABNAME of fields {CreateDD03L}, {FillDD03L}, {CreateAsDD03L}.
For tables you want to delete data by running macro leave field {DeleteAllData} checked.
How to secure data from ADMIN table
In order to secure the 00ADMIN table copy it to another database and keep it safe on your locally PC.
In application database create a link to this table Menu: File/Get external data/Link tables. Now you can share with others application database and keep secure logon data.
How to use data
All data are in text format therefore when you have value fields I suggest to create a query with a MS access function VALl()
When you have to read data from two joined tables you may consider creating of a view in SAP with transaction SE11 and read data from the view.
Sometimes it is required to read data from a standard report. In this case you will need the help of an ABAP programmer if you do not have ABAP experience. Consider following steps: (1) copy the report into a new one, (2) find the ALV function that returns the results, (3) insert the code to store the results of internal table into a transparent table. Once you have data in the transparent table you may use the tool to read them. For instance in report MB5B “Stock on posting date” internal table with displayed data (g_s_totals_flat) is located in SE38/ RM07MLBD row “append g_s_totals_flat to g_t_totals_flat.”
When working with BI you may store data into tables from providers with DB aggregation (instead of individual records).
Generally, when you have to read hundred thousands of records you may consider improving performance by splitting reading with options for instance
Please notice that MS access may have limits of maximum size. Size of one mdb must be less then 2 GB.
2GB limit http://support.microsoft.com/default.aspx?scid=kb;en-us;835416
If required you may integrate MS Access query with MS Excel following in MS Excel menu Data\Import External Data\New database query\Choose Data Sources\MS Access Database
Weaknesses
It works with hundred of thousand of records however reading of millions of records may require a different approach. There is a limit imposed by RFC_READ_TABLE regarding the total length of read fields, the limit is 512.
FUNCTIONS
Function CreateADMIN()
Dim db As Database Dim tdfNew As TableDef
Set db = CurrentDb
On Error Resume Next 'Table does not exist
db.TableDefs.Delete "ADMIN"
On Error GoTo 0 'Reset error handling
Set tdfNew = db.CreateTableDef("00ADMIN") With tdfNew .Fields.Append .CreateField("CNT_STR_APPLN_SRVR", dbText, 50) .Fields.Append .CreateField("CNT_STR_CLIENT", dbText, 50) .Fields.Append .CreateField("CNT_STR_PWD", dbText, 50) .Fields.Append .CreateField("CNT_STR_SYS_NUM", dbText, 50) .Fields.Append .CreateField("CNT_STR_SYSTEM", dbText, 50) .Fields.Append .CreateField("CNT_STR_USR", dbText, 50) .Fields.Append .CreateField("CNT_STR_LOGON_LANG", dbText, 50) .Fields.Append .CreateField("MessageOn", dbBoolean)
' .Fields.Append .CreateField("LogonSilient", dbBoolean) .Fields.Append .CreateField("Active", dbBoolean)
db.TableDefs.Append tdfNew
End With
With tdfNew.Fields("MessageOn")
.Properties.Append .CreateProperty("DisplayControl", _ dbInteger, CInt(acCheckBox))
End With
With tdfNew.Fields("LogonSilient")
.Properties.Append .CreateProperty("DisplayControl", _ dbInteger, CInt(acCheckBox))
End With
With tdfNew.Fields("Active")
.Properties.Append .CreateProperty("DisplayControl", _ dbInteger, CInt(acCheckBox))
End WithEnd Function
Function CreateTABNAME()
Dim db As Database Dim tdfNew As TableDef
Set db = CurrentDb
On Error Resume Next 'Table does not exist
db.TableDefs.Delete "01TABNAME"
On Error GoTo 0 'Reset error handling
Set tdfNew = db.CreateTableDef("01TABNAME") With tdfNew .Fields.Append .CreateField("Tabname", dbText, 30) .Fields.Append .CreateField("Options", dbText, 72) .Fields.Append .CreateField("CreateDD03L", dbBoolean) .Fields.Append .CreateField("FillDD03L", dbBoolean) .Fields.Append .CreateField("CreateAsDD03L", dbBoolean) .Fields.Append .CreateField("ReadAsDD03L", dbBoolean) .Fields.Append .CreateField("ReadAsSQLon", dbBoolean) .Fields.Append .CreateField("DeleteAllData", dbBoolean)
db.TableDefs.Append tdfNew
End With
With tdfNew.Fields("CreateDD03L")
.Properties.Append .CreateProperty("DisplayControl", _ dbInteger, CInt(acCheckBox))
End With
With tdfNew.Fields("FillDD03L")
.Properties.Append .CreateProperty("DisplayControl", _ dbInteger, CInt(acCheckBox))
End With
With tdfNew.Fields("CreateAsDD03L")
.Properties.Append .CreateProperty("DisplayControl", _ dbInteger, CInt(acCheckBox))
End With
With tdfNew.Fields("ReadAsSQLon")
.Properties.Append .CreateProperty("DisplayControl", _ dbInteger, CInt(acCheckBox))
End With
With tdfNew.Fields("ReadAsDD03L")
.Properties.Append .CreateProperty("DisplayControl", _ dbInteger, CInt(acCheckBox))
End With
With tdfNew.Fields("DeleteAllData")
.Properties.Append .CreateProperty("DisplayControl", _ dbInteger, CInt(acCheckBox))
End With
'Create table for method ReadAsSQLon
On Error Resume Next 'Table does not exist
db.TableDefs.Delete "02WA"
On Error GoTo 0 'Reset error handling
Set tdfNew = db.CreateTableDef("02WA") With tdfNew .Fields.Append .CreateField("WA", dbMemo)
db.TableDefs.Append tdfNew
End With
'Allow space records
With tdfNew.Fields("WA")
.Properties("AllowZeroLength") = True
End With
End Function
Function CreateDD03L()
Dim tabname_dd03l As String
Dim db As Database, rst As Recordset
Dim intCounter As Integer, lSum As Long
Dim intUpBound As Integer
Dim tdfNew As TableDef
Set db = CurrentDb
Set rst = db.OpenRecordset("01TABNAME", dbOpenDynaset)
Set rst = db.OpenRecordset("SELECT * FROM 01tabname WHERE [CreateDD03L] = Yes and [Tabname] <> null")
Set rst = rst.OpenRecordset
On Error GoTo PROC_ERR:
rst.MoveLast
On Error GoTo 0
intUpBound = rst.RecordCount
rst.MoveFirst
For intCounter = 1 To intUpBound
tabname_dd03l = "DD03L_" & rst!tabname Set tdfNew = db.CreateTableDef(tabname_dd03l) With tdfNew .Fields.Append .CreateField("Fieldname", dbText, 30) .Fields.Append .CreateField("Position", dbInteger, 4) .Fields.Append .CreateField("DataType", dbText, 4) .Fields.Append .CreateField("Leng", dbInteger, 6) .Fields.Append .CreateField("Choose_Field", dbBoolean) .Fields.Append .CreateField("Order", dbInteger, 4)
db.TableDefs.Append tdfNew
End With
With tdfNew.Fields("Choose_Field") .Properties.Append .CreateProperty("DisplayControl", _ dbInteger, CInt(acCheckBox))
End With
rst.MoveNext
Next intCounter
Exit Function
PROC_ERR:
MsgBox "Error " & Err.Number & " " & Err.Description & " Check field [CreateDD03L] in TABNAME" Exit FunctionEnd Function
Function fillDD03L()
' ''Add the R/3 RFC function RFC_READ_TABLE to the collection
''------------------------------------------------------------
'Set funcControl = CreateObject("SAP.Functions")
'Dim RFC_READ_TABLE As Object
'Dim db As DAO.Database, RS As DAO.Recordset
'Set RFC_READ_TABLE = funcControl.Add("RFC_READ_TABLE")
''------------------------------------------------------------
'' Create objects for each parameter
''------------------------------------------------------------
Dim db As DAO.Database, RS As DAO.Recordset
saptab = "DD03L"
Set db = CurrentDb
Set rstabname = db.OpenRecordset("SELECT * FROM 01TABNAME where FillDD03L = Yes", dbOpenDynaset)
If rstabname.RecordCount = 0 Then MsgBox "No record in TABNAME with FillDD03L = Yes"
Exit Function
End If
On Error GoTo PROC_ERR
rstabname.MoveFirst
Do While Not rstabname.EOF ' Check if tables exist
tabname = rstabname("Tabname")
Set RS = db.OpenRecordset("DD03L_" + tabname)
RS.Close
rstabname.MoveNext
Loop
On Error GoTo 0
Set rsadmin = db.OpenRecordset("SELECT Sum(1) AS [Count] FROM 00ADMIN HAVING Active = Yes", dbOpenDynaset)
If IsNull(rsadmin("Count")) Then
MsgBox "In table 00ADMIN there is no active connection (Active = 'X')." & vbNewLine & "Please logon manually." ActiveConnection = False
Else Select Case rsadmin("Count") Case Is > 1 MsgBox "In table 00ADMIN set only one active connection with Active = 'X'" Exit Function Case 1
ActiveConnection = True End Select
End If
'If rsadmin("Count") > 1 Then
' MsgBox "In table 00ADMIN set only one active connection with Active = 'X'"
'Exit Function
'End If
'
'If rsadmin("Count") >= 1 Then
'' Not Null, only one connection active
'ActiveConnection = True
'Else
'' Null
' MsgBox "In table 00ADMIN there is no active connection (Active = 'X'). Please logon manually"
'ActiveConnection = False
'End If
If ActiveConnection = True Then
' Not Null, only one connection active
Set rsadmin = db.OpenRecordset("SELECT * FROM 00ADMIN where Active = Yes", dbOpenDynaset)
AdmMessageOn = rsadmin("MessageOn")
If AdmMessageOn = True Then
MsgBox "Set connection to Server: " & rsadmin("CNT_STR_APPLN_SRVR") & " Client: " & rsadmin("CNT_STR_CLIENT")
Else RetVal = SysCmd(acSysCmdSetStatus, "Set connection to Server: " & rsadmin("CNT_STR_APPLN_SRVR") & " Client: " & rsadmin("CNT_STR_CLIENT"))
End If
End If
rstabname.MoveFirst
Do While Not rstabname.EOF
Set funcControl = CreateObject("SAP.Functions")
If ActiveConnection = True Then
' Automatic logon
Dim CNT_STR_USR As String
CNT_STR_USR = rsadmin("CNT_STR_USR")
Dim CNT_STR_PWD As String
CNT_STR_PWD = rsadmin("CNT_STR_PWD")
Dim CNT_STR_APPLN_SRVR As String
CNT_STR_APPLN_SRVR = rsadmin("CNT_STR_APPLN_SRVR")
Dim CNT_STR_SYSTEM As String
CNT_STR_SYSTEM = rsadmin("CNT_STR_SYSTEM")
Dim CNT_STR_SYS_NUM As String
CNT_STR_SYS_NUM = rsadmin("CNT_STR_SYS_NUM")
Dim CNT_STR_CLIENT As String
CNT_STR_CLIENT = rsadmin("CNT_STR_CLIENT")
Const CNT_STR_LOGON_LANG As String = "EN"
Const CNT_STR_LOG_FILE As String = "C:\sap_vb.txt"
Const CNT_INT_LOG_LEVEL As Integer = 9
Dim obSAPConn As Object
Set obSAPConn = funcControl.Connection
funcControl.LogLevel = CNT_INT_LOG_LEVEL
With obSAPConn
.ApplicationServer = CNT_STR_APPLN_SRVR
.SystemNumber = CNT_STR_SYS_NUM
.User = CNT_STR_USR
.Password = CNT_STR_PWD
.Language = CNT_STR_LOGON_LANG
.Client = CNT_STR_CLIENT
End With
If obSAPConn.Logon(0, True) = False Then
If AdmMessageOn = True Then MsgBox "R/3 connection failed" Else RetVal = SysCmd(acSysCmdSetStatus, "R/3 connection failed") End If
Else If AdmMessageOn = True Then MsgBox "R/3 connection established" Else RetVal = SysCmd(acSysCmdSetStatus, "R/3 connection established") End If
End If
End If
''------------
'Add the R/3 RFC function RFC_READ_TABLE to the collection
'------------------------------------------------------------
'Set funcControl = CreateObject("SAP.Functions")
Dim RFC_READ_TABLE As Object
Set RFC_READ_TABLE = funcControl.Add("RFC_READ_TABLE")
'------------------------------------------------------------
' Create objects for each parameter
'------------------------------------------------------------
Dim obSAPOption As Object
tabname = rstabname("Tabname")
Set eQUERY_TAB = RFC_READ_TABLE.Exports("QUERY_TABLE")
Set toptions = RFC_READ_TABLE.tables("OPTIONS") '
Set tdata = RFC_READ_TABLE.tables("DATA") '
Set tfields = RFC_READ_TABLE.tables("FIELDS") '
eQUERY_TAB.Value = saptab ' pQueryTab is the R/3 name of the table
Set obSAPOption = RFC_READ_TABLE.tables("OPTIONS")
If obSAPOption.rowcount = 0 Then
obSAPOption.RowS.Add
End If
obSAPOption.Value(1, "TEXT") = "Tabname EQ '" + tabname + "' and Rollname ne ''"
If RFC_READ_TABLE.call = True Then
If tdata.rowcount > 0 Then If AdmMessageOn = True Then MsgBox "Call to RFC_READ_TABLE successful! Data found in DD03L for " + tabname Else RetVal = SysCmd(acSysCmdSetStatus, "Call to RFC_READ_TABLE successful! Data found in " + tabname) End If Else If AdmMessageOn = True Then MsgBox "Call to RFC_READ_TABLE successful! No data found in DD03L for " + tabname Else RetVal = SysCmd(acSysCmdSetStatus, "Call to RFC_READ_TABLE successful! No data found in DD03L for " + tabname) End If End If
Else
If AdmMessageOn = True Then MsgBox "Call to RFC_READ_TABLE failed!"
Else RetVal = SysCmd(acSysCmdSetStatus, "Call to RFC_READ_TABLE failed!")
End If
End If
Dim fieldspos(4) As Integer, fieldsname(4) As String
fieldspos(1) = 2
fieldsname(1) = "FIELDNAME"
fieldspos(2) = 5
fieldsname(2) = "POSITION"
fieldspos(3) = 18
fieldsname(3) = "DataType"
fieldspos(4) = 19
fieldsname(4) = "LENG"
Set RS = db.OpenRecordset("DD03L_" + tabname)
For Each row In tdata.RowS
If row(1) <> "" Then
RS.AddNew For i = 1 To 4 Field = tfields(fieldspos(i), 1) Value = Trim(Mid(row(1), tfields(fieldspos(i), 2) + 1, tfields(fieldspos(i), 3)))
RS(fieldsname(i)) = Value Next i RS.Update
End If tdata.RowS.Remove (1) Next
RS.Close
Set RS = db.OpenRecordset("SELECT * FROM [DD03L_" + tabname + "] order by [position]", dbOpenDynaset)
If RS.RecordCount > 0 Then RS.MoveFirst intCounter = 1 Do While Not RS.EOF RS.Edit
RS("ORDER") = intCounter RS.Update RS.MoveNext intCounter = intCounter + 1 Loop
End If
RS.Close
rstabname.MoveNext
Loop
rstabname.Close
RetVal = SysCmd(acSysCmdRemoveMeter)
Exit Function
PROC_ERR:
MsgBox "Error " & Err.Number & ". " & "Check if table " & tabname & " has been created in step {02 CreateDD03L}" Exit FunctionEnd Function
Function CreateTableAsDD03L()
Dim tabname_dd03l As String
Dim db As Database, rst As Recordset
Dim tdfNew As TableDef
Set db = CurrentDb
Set rst = db.OpenRecordset("SELECT * FROM 01tabname WHERE [CreateAsDD03L] = Yes and [Tabname] <> null")
Set rst = rst.OpenRecordset
rst.MoveFirst
Do While Not rst.EOF
tabname = rst("tabname")
Set rsd = db.OpenRecordset("SELECT * FROM [DD03L_" + tabname + "] WHERE [Choose_Field] = Yes order by [Order]")
Set rsd = rsd.OpenRecordset
rsd.MoveFirst
Set tdfNew = db.CreateTableDef(tabname)
Do While Not rsd.EOF
With tdfNew .Fields.Append .CreateField(rsd("FieldName"), dbText, rsd("leng"))
End With
rsd.MoveNext
Loop
db.TableDefs.Append tdfNew
rsd.Close
rst.MoveNext
Loop
rst.Close
End Function
Function ReadTableAsDD03L()
Dim db As DAO.Database, RS As DAO.Recordset
Dim RecordString As String
Dim obSAPOption As Object
Dim tabname As String
Dim options As String
Set db = CurrentDb
Set rstabname = db.OpenRecordset("SELECT * FROM 01TABNAME where ReadAsDD03L = Yes", dbOpenDynaset)
If rstabname.RecordCount = 0 Then
MsgBox "No record in TABNAME with ReadAsDD03L = Yes"
Exit Function
End If
'Set rsadmin = db.OpenRecordset("SELECT * FROM 00ADMIN where LogonSilient = Yes and Active = Yes", dbOpenDynaset)
''Only first record is used for logon
'If rsadmin.RecordCount <> 0 Then
' rsadmin.MoveFirst
'Else
' MsgBox "In table ADMIN set one active connection with Active = 'X'"
' Exit Function
'End If
'AdmMessageOn = rsadmin("MessageOn")
'
'If AdmMessageOn = True Then
' MsgBox "Set connection to Server: " & rsadmin("CNT_STR_APPLN_SRVR") & " Client: " & rsadmin("CNT_STR_CLIENT")
'Else
' RetVal = SysCmd(acSysCmdSetStatus, "Set connection to Server: " & rsadmin("CNT_STR_APPLN_SRVR") & " Client: " & rsadmin("CNT_STR_CLIENT"))
'End If
Set rsadmin = db.OpenRecordset("SELECT Sum(1) AS [Count] FROM 00ADMIN HAVING Active = Yes", dbOpenDynaset)
If IsNull(rsadmin("Count")) Then
MsgBox "In table 00ADMIN there is no active connection (Active = 'X')." & vbNewLine & "Please logon manually." ActiveConnection = False
Else Select Case rsadmin("Count") Case Is > 1 MsgBox "In table 00ADMIN set only one active connection with Active = 'X'" Exit Function Case 1 ActiveConnection = True End Select
End If
'If rsadmin("Count") > 1 Then
' MsgBox "In table 00ADMIN set only one active connection with Active = 'X'"
'Exit Function
'End If
'
'If rsadmin("Count") >= 1 Then
'' Not Null, only one connection active
'ActiveConnection = True
'Else
'' Null
' MsgBox "In table 00ADMIN there is no active connection (Active = 'X'). Please logon manually"
'ActiveConnection = False
'End If
If ActiveConnection = True Then
' Not Null, only one connection active
Set rsadmin = db.OpenRecordset("SELECT * FROM 00ADMIN where Active = Yes", dbOpenDynaset)
AdmMessageOn = rsadmin("MessageOn")
If AdmMessageOn = True Then
MsgBox "Set connection to Server: " & rsadmin("CNT_STR_APPLN_SRVR") & " Client: " & rsadmin("CNT_STR_CLIENT")
Else RetVal = SysCmd(acSysCmdSetStatus, "Set connection to Server: " & rsadmin("CNT_STR_APPLN_SRVR") & " Client: " & rsadmin("CNT_STR_CLIENT"))
End If
End If
rstabname.MoveFirst
Do While Not rstabname.EOF
tabname = rstabname("Tabname")
If IsNull(Trim(rstabname("Options"))) Then
msg_options = "EMPTY"
Else msg_options = Trim(rstabname("Options"))
End If
'->Check if sum of length not greater then 512, SE37/RFC_READ_TABLE, TABLES/TAB512
tabnamedd = "[DD03L_" + tabname + "]"
tableng = "SELECT Sum(" + tabnamedd + "." + "Leng) AS SumOfLeng " & _
"FROM " + tabnamedd + " " & _
"WHERE (((" + tabnamedd + ".Choose_Field)=Yes))"
Set rsleng = db.OpenRecordset(tableng, dbOpenDynaset)
valleng = rsleng("SumOfLeng")
If valleng > 512 Then
MsgBox "In table " & tabnamedd & " sum of fields length " + CStr(valleng) + " > 512. Execution terminated."
Exit Function
End If
'<-
Set funcControl = CreateObject("SAP.Functions")
'If rsadmin.RecordCount <> 0 Then
If ActiveConnection = True Then
' Automatic logon
Dim CNT_STR_USR As String
CNT_STR_USR = rsadmin("CNT_STR_USR")
Dim CNT_STR_PWD As String
CNT_STR_PWD = rsadmin("CNT_STR_PWD")
Dim CNT_STR_APPLN_SRVR As String
CNT_STR_APPLN_SRVR = rsadmin("CNT_STR_APPLN_SRVR")
Dim CNT_STR_SYSTEM As String
CNT_STR_SYSTEM = rsadmin("CNT_STR_SYSTEM")
Dim CNT_STR_SYS_NUM As String
CNT_STR_SYS_NUM = rsadmin("CNT_STR_SYS_NUM")
Dim CNT_STR_CLIENT As String
CNT_STR_CLIENT = rsadmin("CNT_STR_CLIENT")
Const CNT_STR_LOGON_LANG As String = "EN"
Const CNT_STR_LOG_FILE As String = "C:\sap_vb.txt"
Const CNT_INT_LOG_LEVEL As Integer = 9
Dim obSAPConn As Object
Set obSAPConn = funcControl.Connection
funcControl.LogLevel = CNT_INT_LOG_LEVEL
With obSAPConn
.ApplicationServer = CNT_STR_APPLN_SRVR
.SystemNumber = CNT_STR_SYS_NUM
.User = CNT_STR_USR
.Password = CNT_STR_PWD
.Language = CNT_STR_LOGON_LANG
.Client = CNT_STR_CLIENT
End With
If obSAPConn.Logon(0, True) = False Then
If AdmMessageOn = True Then MsgBox "R/3 connection failed" Else RetVal = SysCmd(acSysCmdSetStatus, "R/3 connection failed") End If
Else If AdmMessageOn = True Then MsgBox "R/3 connection established" Else RetVal = SysCmd(acSysCmdSetStatus, "R/3 connection established") End If
End If
End If
'Add the R/3 RFC function RFC_READ_TABLE to the collection
'------------------------------------------------------------
'Set funcControl = CreateObject("SAP.Functions")
Dim RFC_READ_TABLE As Object
Set RFC_READ_TABLE = funcControl.Add("RFC_READ_TABLE")
'------------------------------------------------------------
' Create objects for each parameter
'------------------------------------------------------------
Set eQUERY_TAB = RFC_READ_TABLE.Exports("QUERY_TABLE")
Set toptions = RFC_READ_TABLE.tables("OPTIONS") '
Set tdata = RFC_READ_TABLE.tables("DATA") '
Set tfields = RFC_READ_TABLE.tables("FIELDS") '
eQUERY_TAB.Value = tabname ' pQueryTab is the R/3 name of the table
Set obSAPOption = RFC_READ_TABLE.tables("OPTIONS")
If Trim(rstabname("Options")) <> "" Then
obSAPOption.RowS.Add obSAPOption.Value(1, "TEXT") = rstabname("Options")
End If
'DEVELOP
Set RsDD03L = db.OpenRecordset("SELECT * FROM [DD03L_" + tabname + "] where Choose_Field = Yes order by [order]", dbOpenDynaset)
RsDD03L.MoveFirst
Do While Not RsDD03L.EOF
tfields.RowS.Add tfields.Value(RsDD03L.AbsolutePosition + 1, "FIELDNAME") = RsDD03L("Fieldname") RsDD03L.MoveNext
Loop
RsDD03L.Close
RetVal = SysCmd(acSysCmdSetStatus, "Reading data from table " & tabname & " with OPTIONS: " & msg_options & ".")
If RFC_READ_TABLE.call = True Then
If tdata.rowcount > 0 Then If AdmMessageOn = True Then MsgBox "Call to RFC_READ_TABLE successful! Data found in " + tabname + " with OPTIONS: " + msg_options + "." End If Else If AdmMessageOn = True Then MsgBox "Call to RFC_READ_TABLE successful! No data found in " + tabname + " with OPTIONS: " + msg_options + "." End If End If
Else
If AdmMessageOn = True Then MsgBox "Call to RFC_READ_TABLE failed!"
End If
End If
Set RsDD03L = db.OpenRecordset("SELECT * FROM [DD03L_" + tabname + "] where Choose_Field = Yes order by [order]", dbOpenDynaset)
Dim sqlon As Boolean
sqlon = rstabname("ReadAsSQLon")
If sqlon = False Then
Set RS = db.OpenRecordset(tabname)
End If
Dim CurrentRow As Long
Dim count As Long
Dim Sinit As Date
Dim Snow As Date
Dim Spass As Long
Dim RowS As String
count = tdata.rowcount
CurrentRow = 0
Sinit = Now()
If sqlon = True Then
db.Execute ("delete * from 02WA") sql_fieldpos = RsDD03L.RecordCount
End If
For Each row In tdata.RowS
'-> Speed on status bar
CurrentRow = CurrentRow + 1
Snow = Now()
Spass = DateDiff("s", Sinit, Snow)
Avg = Round(1000 * (Spass / CurrentRow), 2)
RetVal = SysCmd(acSysCmdSetStatus, "Inserting Records in " + tabname + " ..." + CStr(CurrentRow) + " of " + CStr(count) + ". Elapsed time " + CStr(Spass) + " sec." + " Average 1000 rec./" + CStr(Avg) + " sec.")
'<-
'SQL->
'http://msdn.microsoft.com/en-us/library/ms188365.aspx
'BULK INSERT bulktest..t_float
'FROM 'C:\t_float-c.dat' WITH (FORMATFILE='C:\t_floatformat-c-xml.xml');
'GO
'If accepted loop can be replaced with one SQL string and better performance
If sqlon = True Then
If row(1) <> "" Then RowS = Replace(row(1), "'", "''") row_len_req = Val(tfields((sql_fieldpos), 2)) + Val(tfields(sql_fieldpos, 3))
'In order to complete to full length when last field is empty RowS = RowS + String(row_len_req - Len(RowS), " ") + "!" db.Execute ("INSERT INTO 02WA (WA) VALUES ('" & RowS & "')")
End If
End If
'SQL<-
If sqlon = False Then
RecordString = ""
If row(1) <> "" Then
RS.AddNew
RsDD03L.MoveFirst Do While Not RsDD03L.EOF fieldpos = RsDD03L.AbsolutePosition + 1 FieldName = RsDD03L("Fieldname") Field = tfields(fieldpos, 1) Value = Trim((Mid(row(1), tfields((fieldpos), 2) + 1, tfields(fieldpos, 3)))) If Value <> "" Then
RS(FieldName) = Value End If
RecordString = RecordString + Value RsDD03L.MoveNext Loop If RecordString <> "" Then RS.Update End If
End If
End If
Next
If sqlon = False Then
RS.Close
End If
'SQL->
If sqlon = True Then
StrInto = "": StrFrom = "": St = "": En = ""
Set RsDD03L = db.OpenRecordset("SELECT * FROM [DD03L_" + tabname + "] where Choose_Field = Yes order by [order]", dbOpenDynaset)
RsDD03L.MoveFirst Do While Not RsDD03L.EOF fieldpos = RsDD03L.AbsolutePosition + 1 FieldName = RsDD03L("Fieldname") Field = tfields(fieldpos, 1) If fieldpos <> 1 Then StrSp = ", " Else StrSp = "" End If StrInto = StrInto + StrSp + "[" + FieldName + "]" St = Val(tfields((fieldpos), 2) + 1) En = Val(tfields(fieldpos, 3)) StrFrom = StrFrom + StrSp + "Mid([02WA]![WA]," + CStr(St) + "," + CStr(En) + ") AS " + "[" + FieldName + "]"
RsDD03L.MoveNext
Loop
RsDD03L.Close
StrSQL = "INSERT INTO " & _
" [" + tabname + "] " & _
" ( " & _
StrInto & _
")" & _
" SELECT " & _
StrFrom & _
" FROM 02WA"
'Uncomment in order to insert generated SQL in last row of 02WA for analysis purpose
'db.Execute ("INSERT INTO 02WA (WA) VALUES ('" & StrSQL & "')")
db.Execute (StrSQL)
End If
'SQL<-
rstabname.MoveNext
Loop
rstabname.Close
rsadmin.Close
RetVal = SysCmd(acSysCmdRemoveMeter)
End Function
Function DeleteAsTabname()
Dim dbs As Database, rst As Recordset
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("SELECT * FROM 01tabname WHERE [DeleteAllData] = Yes and [Tabname] <> null")
Set rst = rst.OpenRecordset
If rst.RecordCount <> 0 Then
rst.MoveFirst
Do While Not rst.EOF
dbs.Execute "DELETE * FROM [" & rst("Tabname") & "]" rst.MoveNext
Loop
rst.Close
End If
End Function
Function RRemoveMeter()
RetVal = SysCmd(acSysCmdInitMeter, "Ready", 1) RetVal = SysCmd(acSysCmdRemoveMeter)
End Function
Related Content
Copyright
© Copyright 2012 SAP AG. All rights reserved.
No part of this publication may be reproduced or transmitted in any form or for any purpose without the express permission of SAP AG and Author. The information contained herein may be changed without prior notice.
Some software products marketed by SAP AG and its distributors contain proprietary software components of other software vendors.
Microsoft, Windows, Excel, Outlook, and PowerPoint are registered trademarks of Microsoft Corporation.
IBM, DB2, DB2 Universal Database, System i, System i5, System p, System p5, System x, System z, System z10, System z9, z10, z9, iSeries, pSeries, xSeries, zSeries, eServer, z/VM, z/OS, i5/OS, S/390, OS/390, OS/400, AS/400, S/390 Parallel Enterprise Server, PowerVM, Power Architecture, POWER6+, POWER6, POWER5+, POWER5, POWER, OpenPower, PowerPC, BatchPipes, BladeCenter, System Storage, GPFS, HACMP, RETAIN, DB2 Connect, RACF, Redbooks, OS/2, Parallel Sysplex, MVS/ESA, AIX, Intelligent Miner, WebSphere, Netfinity, Tivoli and Informix are trademarks or registered trademarks of IBM Corporation.
Linux is the registered trademark of Linus Torvalds in the U.S. and other countries.
Adobe, the Adobe logo, Acrobat, PostScript, and Reader are either trademarks or registered trademarks of Adobe Systems Incorporated in the United States and/or other countries.
Oracle is a registered trademark of Oracle Corporation.
UNIX, X/Open, OSF/1, and Motif are registered trademarks of the Open Group.
Citrix, ICA, Program Neighborhood, MetaFrame, WinFrame, VideoFrame, and MultiWin are trademarks or registered trademarks of Citrix Systems, Inc.
HTML, XML, XHTML and W3C are trademarks or registered trademarks of W3C®, World Wide Web Consortium, Massachusetts Institute of Technology.
Java is a registered trademark of Sun Microsystems, Inc.
JavaScript is a registered trademark of Sun Microsystems, Inc., used under license for technology invented and implemented by Netscape.
SAP, R/3, SAP NetWeaver, Duet, PartnerEdge, ByDesign, SAP Business ByDesign, and other SAP products and services mentioned herein as well as their respective logos are trademarks or registered trademarks of SAP AG in Germany and other countries.
Business Objects and the Business Objects logo, BusinessObjects, Crystal Reports, Crystal Decisions, Web Intelligence, Xcelsius, and other Business Objects products and services mentioned herein as well as their respective logos are trademarks or registered trademarks of Business Objects S.A. in the United States and in other countries. Business Objects is an SAP company.
All other product and service names mentioned are the trademarks of their respective companies. Data contained in this document serves informational purposes only. National product specifications may vary.
These materials are subject to change without notice. These materials are provided by SAP AG and its affiliated companies ("SAP Group") for informational purposes only, without representation or warranty of any kind, and SAP Group shall not be liable for errors or omissions with respect to the materials. The only warranties for SAP Group products and services are those that are set forth in the express warranty statements accompanying such products and services, if any. Nothing herein should be construed as constituting an additional warranty.