Sergiu Iatco

August 16, 2013 22 minute read

Read data from SAP tables into MS Access 2003 database

Applies to:	SAP and MS Access
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
Errors
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. Also you may download a ready to use database here.

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

Errors

Please verify Comments.

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 With

End 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 Function

End 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
.System = CNT_STR_SYSTEM 'Added on 22.05.2017
.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 Function

End 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
.System = CNT_STR_SYSTEM 'Added on 22.05.2017
.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

Copyright

No part of this publication may be reproduced or transmitted in any form or for any purpose without the express permission of Author.

The information contained herein may be changed without prior notice.

Nothing herein should be construed as constituting an additional warranty.

15 Comments

You must be Logged on to comment or reply to a post.

Henrik C. Madsen

October 14, 2013 at 5:11 am

One minor typo in the code, but otherwise works really well! And of course I can't remember now where it was, but it was obvious when it didn't work.

Took me a bit of time to wrap my head around your approach, but now it makes totally sense!

thanks a lot for this.

Sergiu Iatco

Blog Post Author

November 1, 2013 at 1:38 pm

If it works for you it should work for others too. If there are mistakes or difficult parts to understand let me know and I will try to improve the article. Thanks.

Former Member

November 19, 2013 at 12:22 pm

This is really good and I see many uses for it - I currently extract lots of data regularly for testing and ensuring data integrity after a go-live and I can see how I can use this to automate at least some of this. So, great job - and many thanks for sharing this!!

I have one question:- in the Options in TABNAME, I would like to use a subquery but have been unable to get it to work. Does the RFC support subqueries?

I was trying to extract data from MARA, and the Options string I had was:

MATNR IN (select MATNR from MARC where WERKS EQ '1111')

No matter what variation I made, I got an error message

Call to RFC_READ_TABLE failed!

Is this possible, or will I have to try a different approach?

Thanks.

Sergiu Iatco

Blog Post Author

November 19, 2013 at 1:31 pm

When call fails, you have to check how it works in SE37/RFC_READ_TABLE. Subquery is not supported by SE37/RFC_READ_TABLE. The solution to your issue is to create a database view with SE11/ZV_MARA_MARC. Database views are supported by SE37/RFC_READ_TABLE.

Former Member

July 1, 2015 at 6:40 pm

Thx a lot for this code

I have one probleme with wdbrtre2.ocx because I use Access 2013

Have you a solution for this probleme ?

Thx

Sergiu Iatco

Blog Post Author

July 3, 2015 at 11:06 am

In case of inexplicable errors or errors as the one below, try following.

Tools/Macro/Visual Basic Editor.

Tools/References.

Uncheck all unnecessary Available References.

Check only Available References shown below.

Former Member

October 13, 2015 at 2:39 pm

Hi,

Thx a lot for this answer

Former Member

September 25, 2015 at 9:43 pm

This will help me so much with a little personnal project I'm making, provided I can extract the data.

I tried extracting data from table USR02 as practice but the connection always fails with message "R/3 Connection Failed".

I'm pretty sure the informations I gave table 00ADMIN is valid - my user also has access to the data and RFC.

Do I need to define a particular RFC in the system I want to extract the data from?

If so, could I use one that is already defined in SM59 instead?

Thanks!

Former Member

October 13, 2015 at 3:02 pm

Hi,

Normaly no. You need only access to Tcode SE16 or SE16N.

I can send you by mail another vba code to test and check If you have access with RFC.

I can't paste this code in this page, I don't know why.

Regards

Stacy Vickery

February 1, 2018 at 10:52 pm

What if your company created a ZSE16?

Former Member

January 4, 2016 at 3:29 pm

Great article and this is proving to be very useful to me. I have one table LTAP that I get over 300K recrods back. It was really slow. I found that changing it so it only wrote to the screen for every 1000 records doubled my throughput. Make this change in your 05 module to get a performance increase. It is around the RetVal statement that updates the status line.

Avg = Round(1000 * (Spass / CurrentRow), 2)

If count > 1000 And count - CurrentRow > 1000 Then

Location = (CurrentRow / 1000)

Location = Location - Int(Location)

Else

Location = 0

End If

If Location = 0 Then

RetVal = SysCmd(acSysCmdSetStatus, "Inserting Records in " + tabname + " ..." + CStr(CurrentRow) + " of " + CStr(count) + ". Elapsed time " + CStr(Spass) + " sec." + " Average 1000 rec./" + CStr(Avg) + " sec.")

End If

KARTHIK KESAVAN

January 25, 2016 at 11:59 am

Hi Experts,

I cannot able to access the original code in SAP logon 740 which was working in 720. Can you please guide me what needs to be modified to work in SAP Logon 740. Thanks.

Regards,

Kaarthi

Johan Lauwens

September 27, 2017 at 10:37 am

Same issue as Kaarthi is facing. How would this work with 740?

Kind regards,

Johan

Henrik Madsen

October 21, 2019 at 12:24 am

I know this is old, but still very useful!!

After upgrading the GUI to 7.50, I can only download one table at a time, and then MS Access dies. If I only select one table to download, it works as expected, but it seems like the connection to SAP isn’t closed.

Anyone figure out what changes are required to make this work with 7.50?

* I installed GUI 7.60, and now it's working - so must have been a bug in the 7.50 version I was using...

thanks,

Henrik

Johan Lauwens

April 28, 2021 at 1:10 pm

Henrik

Moved to 7.60 on Win10 with 64bit Access instead of 32 bit Access

Stopped working. Missing sapirrfc.dll and sapirrlb.dll ...

How did you manage to get this working?

Thank you

Johan

Read data from SAP tables into MS Access 2003 database

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

Errors

Weaknesses

FUNCTIONS

Function CreateADMIN()

Function CreateTABNAME()

Function CreateDD03L()

Function fillDD03L()

Function CreateTableAsDD03L()

Function ReadTableAsDD03L()

Function DeleteAsTabname()

Function RRemoveMeter()

Related Content

Copyright

Assigned Tags