How to create modules as functions

Sergiu · ‎08-16-2013

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.

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

Get Started with the ABAP Development Tools for SAP NetWeaver

Become an ABAP in Eclipse Feature Explorer and earn the Explorer Badge

Six kinds of debugging tips to find the source code where the message is raised