Application Development Blog Posts
Learn and share on deeper, cross technology development topics such as integration and connectivity, automation, cloud extensibility, developing at scale, and security.
cancel
Showing results for 
Search instead for 
Did you mean: 
Sergiu
Contributor

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

 



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

Related Content




Copyright


© Copyright 2012. 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 Author.


The information contained herein may be changed without prior notice.


Nothing herein should be construed as constituting an additional warranty.



15 Comments
Labels in this area