VBA & RFC_READ_TABLE mit GUI750 SP8

VBA & RFC_READ_TABLE mit GUI750 SP8

' Example: calling BAPI RFC_READ_TABELE
Option Explicit
Public Functions As SAPFunctionsOCX.SAPFunctions
Public TableFactory As SAPTableFactoryCtrl.SAPTableFactory

Private LogonControl As SAPLogonCtrl.SAPLogonControl
Private Connection As SAPLogonCtrl.Connection

Dim Func As SAPFunctionsOCX.Function
'Dim Bapi As SAPBAPIControlLib.SAPBusinessObject

Public TabObj As Object
Private Sub Logon()
Dim retcode As Boolean
Dim SilentLogon As Boolean

' Get SAP Objects
Set LogonControl = CreateObject("SAP.LogonControl.Unicode.1")
Set Functions = CreateObject("SAP.Functions.Unicode")
Set TableFactory = CreateObject("SAP.TableFactory.Unicode.1")

'Define Connection objetc
Set Connection = LogonControl.NewConnection

Connection.UseSAPLogonIni = True
SilentLogon = False 'True, if you want to provide Logon parameters

retcode = Connection.Logon(1, SilentLogon)

'Check return code
If retcode <> True Then
MsgBox "Logon failed"
Exit Sub
End If

'Assign connection
Functions.Connection = Connection

End Sub



Private Sub Main()
Dim ix As Long
Dim imax As Long

Dim T() As String
Dim i As Long
Dim k As Long


'Assign SAP rfc function module
Set Func = Functions.Add("RFC_READ_TABLE")
'Func.Exports("DELIMITER") = vbTab


'Import Paramteres
Dim iQuery_Table As SAPFunctionsOCX.Parameter
Dim iDelimiter As SAPFunctionsOCX.Parameter
Dim iNo_Data As SAPFunctionsOCX.Parameter
Dim iRowSkips As SAPFunctionsOCX.Parameter
Dim iRowCounts As SAPFunctionsOCX.Parameter

'Export

'Tables
Dim tOptions As SAPTableFactoryCtrl.Table
Dim tFields As SAPTableFactoryCtrl.Table
Dim tData As SAPTableFactoryCtrl.Table


'Import Parameter of rfc function module
Set iQuery_Table = Func.Exports("QUERY_TABLE")
Set iDelimiter = Func.Exports("DELIMITER")
Set iNo_Data = Func.Exports("NO_DATA")
Set iRowSkips = Func.Exports("ROWSKIPS")
Set iRowCounts = Func.Exports("ROWCOUNT")

iDelimiter.Value = vbTab

'Export Parameter of rfc function module
'not used by rfc_read_table

'Tables rfc function module
Set tFields = Func.Tables("FIELDS")
Set tOptions = Func.Tables("OPTIONS")
Set tData = Func.Tables("DATA")

'Assign values to Import parameter
iQuery_Table.Value = "T001W"

'Assign values to Import tables
tOptions.AppendRow
tOptions(1, "TEXT") = "WERKS = '8000'" 'max 72 char

tFields.AppendRow
tFields(1, "FIELDNAME") = "WERKS"

tFields.AppendRow
tFields(2, "FIELDNAME") = "NAME1"

Func.Call
Debug.Print tData.RowCount
imax = tData.RowCount
For ix = 1 To imax
Debug.Print tData(ix, 1)
i = 0
T = Split(tData(ix, 1), vbTab)
Do While i < tFields.RowCount
Debug.Print T(i)
i = i + 1
Loop
Next

'Release rfc function
Functions.RemoveAll

End Sub


Private Sub Main2()
Dim ix As Long
Dim imax As Long

Dim T() As String
Dim i As Long
Dim k As Long

'Assign SAP rfc function module
Set Func = Functions.Add("RFC_READ_TABLE")

'Func.Exports("DELIMITER") = vbTab

'Import Paramteres
Dim iQuery_Table As SAPFunctionsOCX.Parameter
Dim iDelimiter As SAPFunctionsOCX.Parameter
Dim iNo_Data As SAPFunctionsOCX.Parameter
Dim iRowSkips As SAPFunctionsOCX.Parameter
Dim iRowCounts As SAPFunctionsOCX.Parameter

'Export

'Tables
Dim tOptions As SAPTableFactoryCtrl.Table
Dim tFields As SAPTableFactoryCtrl.Table
Dim tData As SAPTableFactoryCtrl.Table


'Import Parameter of rfc function module
Set iQuery_Table = Func.Exports("QUERY_TABLE")
Set iDelimiter = Func.Exports("DELIMITER")
Set iNo_Data = Func.Exports("NO_DATA")
Set iRowSkips = Func.Exports("ROWSKIPS")
Set iRowCounts = Func.Exports("ROWCOUNT")

iDelimiter.Value = vbTab


'Export Parameter of rfc function module
'not used by rfc_read_table

'Tables rfc function module
Set tFields = Func.Tables("FIELDS")
Set tOptions = Func.Tables("OPTIONS")
Set tData = Func.Tables("DATA")

'Assign values to Import parameter
iQuery_Table.Value = "MSEG"

'Assign values to Import tables
tOptions.AppendRow
tOptions(1, "TEXT") = "MBLNR EQ '4900589198' AND MJAHR EQ '2018' AND BWART EQ '412'" 'max 72 char

tFields.AppendRow
tFields(1, "FIELDNAME") = "MBLNR"
tFields.AppendRow
tFields(2, "FIELDNAME") = "MJAHR"
tFields.AppendRow
tFields(3, "FIELDNAME") = "ZEILE"
tFields.AppendRow
tFields(4, "FIELDNAME") = "BWART"
tFields.AppendRow
tFields(5, "FIELDNAME") = "MATNR"
tFields.AppendRow
tFields(6, "FIELDNAME") = "WERKS"
tFields.AppendRow
tFields(7, "FIELDNAME") = "LGORT"
tFields.AppendRow
tFields(8, "FIELDNAME") = "CHARG"
tFields.AppendRow
tFields(9, "FIELDNAME") = "SOBKZ"
tFields.AppendRow
tFields(10, "FIELDNAME") = "LIFNR"
tFields.AppendRow
tFields(11, "FIELDNAME") = "KUNNR"
tFields.AppendRow
tFields(12, "FIELDNAME") = "KDAUF"
tFields.AppendRow
tFields(13, "FIELDNAME") = "KDPOS"
tFields.AppendRow
tFields(14, "FIELDNAME") = "PLPLA"
tFields.AppendRow
tFields(15, "FIELDNAME") = "ERFMG"
tFields.AppendRow
tFields(16, "FIELDNAME") = "ERFME"
tFields.AppendRow
tFields(17, "FIELDNAME") = "EBELN"
tFields.AppendRow
tFields(18, "FIELDNAME") = "EBELP"
tFields.AppendRow
tFields(19, "FIELDNAME") = "SGTXT"
tFields.AppendRow
tFields(20, "FIELDNAME") = "WEMPF"
tFields.AppendRow
tFields(21, "FIELDNAME") = "ABLAD"
tFields.AppendRow
tFields(22, "FIELDNAME") = "KOSTL"
tFields.AppendRow
tFields(23, "FIELDNAME") = "AUFNR"
tFields.AppendRow
tFields(24, "FIELDNAME") = "ANLN1"
tFields.AppendRow
tFields(25, "FIELDNAME") = "ANLN2"
tFields.AppendRow
tFields(26, "FIELDNAME") = "GJAHR"
tFields.AppendRow
tFields(27, "FIELDNAME") = "PS_PSP_PNR"
tFields.AppendRow
tFields(28, "FIELDNAME") = "BSTMG"
tFields.AppendRow
tFields(29, "FIELDNAME") = "BSTME"
tFields.AppendRow
tFields(30, "FIELDNAME") = "MANDT"

Func.Call
Debug.Print tData.RowCount
imax = tData.RowCount
For ix = 1 To imax
Debug.Print tData(ix, 1)
i = 0
T = Split(tData(ix, 1), vbTab)
Do While i < tFields.RowCount
Debug.Print T(i)
i = i + 1
Loop
Next

'Release rfc function
Functions.RemoveAll

End Sub

Sub Start()
Logon
Main
Main2
Main
Main2
Main
Main2
Connection.Logoff
End Sub