'-Begin-----------------------------------------------------------------
'-Directives----------------------------------------------------------
Option Explicit
'-Constants-----------------------------------------------------------
Const RFC_OK = 0
'-Sub GetTableInfo------------------------------------------------------
'-
'- Reads a few technical information about a transparent table from
'- data dictionary table DD03L from an SAP system via CCo
'-
'-----------------------------------------------------------------------
Sub GetTableInfo(TableName As String)
'-Variables---------------------------------------------------------
#If Win64 Then
Dim SAP As Object
#Else
Dim SAP As CCo.COMNWRFC
#End If
Dim hRFC As Long
Dim hFuncDesc As Long
Dim rc As Integer
Dim hFunc As Long
Dim hOptions As Long
Dim hTable As Long
Dim hFields As Long
Dim hRow As Long
Dim rowCount As Long
Dim charBuffer As String
Dim i As Long
Dim Fields() As String
Dim j As Long
Set SAP = CreateObject("COMNWRFC")
If Not IsObject(SAP) Then
Exit Sub
End If
hRFC = SAP.RfcOpenConnection("ASHOST=ABAP, SYSNR=00, " & _
"CLIENT=001, USER=BCUSER")
If hRFC = 0 Then
Set SAP = Nothing
Exit Sub
End If
hFuncDesc = SAP.RfcGetFunctionDesc(hRFC, "RFC_READ_TABLE")
If hFuncDesc = 0 Then
rc = SAP.RfcCloseConnection(hRFC)
Set SAP = Nothing
Exit Sub
End If
hFunc = SAP.RfcCreateFunction(hFuncDesc)
If hFunc = 0 Then
rc = SAP.RfcCloseConnection(hRFC)
Set SAP = Nothing
Exit Sub
End If
rc = SAP.RfcSetChars(hFunc, "QUERY_TABLE", "DD03L")
rc = SAP.RfcSetChars(hFunc, "DELIMITER", "~")
If SAP.RfcGetTable(hFunc, "FIELDS", hFields) = RFC_OK Then
hRow = SAP.RfcAppendNewRow(hFields)
rc = SAP.RfcSetChars(hRow, "FIELDNAME", "TABNAME")
hRow = SAP.RfcAppendNewRow(hFields)
rc = SAP.RfcSetChars(hRow, "FIELDNAME", "FIELDNAME")
hRow = SAP.RfcAppendNewRow(hFields)
rc = SAP.RfcSetChars(hRow, "FIELDNAME", "POSITION")
hRow = SAP.RfcAppendNewRow(hFields)
rc = SAP.RfcSetChars(hRow, "FIELDNAME", "KEYFLAG")
hRow = SAP.RfcAppendNewRow(hFields)
rc = SAP.RfcSetChars(hRow, "FIELDNAME", "DATATYPE")
hRow = SAP.RfcAppendNewRow(hFields)
rc = SAP.RfcSetChars(hRow, "FIELDNAME", "LENG")
hRow = SAP.RfcAppendNewRow(hFields)
rc = SAP.RfcSetChars(hRow, "FIELDNAME", "DECIMALS")
End If
If SAP.RfcGetTable(hFunc, "OPTIONS", hOptions) = RFC_OK Then
hRow = SAP.RfcAppendNewRow(hOptions)
rc = SAP.RfcSetChars(hRow, "TEXT", "TABNAME = '" & TableName & "'")
End If
If SAP.RfcInvoke(hRFC, hFunc) = RFC_OK Then
'-Get the column titels-------------------------------------------
rc = SAP.RfcGetTable(hFunc, "FIELDS", hFields)
If SAP.RfcGetRowCount(hFields, rowCount) = RFC_OK Then
rc = SAP.RfcMoveToFirstRow(hFields)
For i = 1 To rowCount
hRow = SAP.RfcGetCurrentRow(hFields)
rc = SAP.RfcGetChars(hRow, "FIELDNAME", charBuffer, 30)
Cells(1, i) = Trim(charBuffer)
If i < rowCount Then
rc = SAP.RfcMoveToNextRow(hFields)
End If
Next
End If
'-Get the table data of data dictionary table DD03L---------------
rc = SAP.RfcGetTable(hFunc, "DATA", hTable)
If SAP.RfcGetRowCount(hTable, rowCount) = RFC_OK Then
rc = SAP.RfcMoveToFirstRow(hTable)
For i = 1 To rowCount
hRow = SAP.RfcGetCurrentRow(hTable)
rc = SAP.RfcGetChars(hRow, "WA", charBuffer, 512)
Fields = Split(charBuffer, "~")
For j = 0 To UBound(Fields)
Cells(i + 1, j + 1) = Trim(Fields(j))
Next
If i < rowCount Then
rc = SAP.RfcMoveToNextRow(hTable)
End If
Next
End If
End If
rc = SAP.RfcDestroyFunction(hFunc)
rc = SAP.RfcCloseConnection(hRFC)
Set SAP = Nothing
End Sub
'-Sub Main--------------------------------------------------------------
Sub Main()
Dim TableName As String
TableName = InputBox("Name of the transparent table")
If TableName <> "" Then
UsedRange.ClearContents
GetTableInfo TableName
End If
End Sub
'-End-------------------------------------------------------------------
You must be a registered user to add a comment. If you've already registered, sign in. Otherwise, register and sign in.
User | Count |
---|---|
4 | |
4 | |
4 | |
3 | |
3 | |
3 | |
3 | |
3 | |
2 | |
2 |