As I wrote here is the function module RFC_READ_TABLE very important for many Excel-VBA programmers. But RFC_READ_TABLE has a strong restriction: The length of a result line can not be longer as 512 characters. Here an example how to soften this restriction. My approach is very easy: I read a table column by column. On this way it is possible to read fields with a maximum length of 512 characters, the length of a line is all the same. If a field is longer as 512 characters the VBA programs skips it automatically. So we can use RFC_READ_TABLE very comfortable, and the length problem is reduced.
At first I load from data dictionary the field names, length etc. into an array. The array is sorted by the position of the fields, on this way we get an exact copy of the SAP table. In the next step I loop over the array, load the table column by column and write the field content into the Excel cells. This method is very slow, but it expands the possibilities of RFC_READ_TABLE.
'-Begin----------------------------------------------------------------- '-Directives---------------------------------------------------------- Option Explicit Option Base 1 '-Constants----------------------------------------------------------- Const RFC_OK = 0 '-Structures---------------------------------------------------------- Type FieldSpecs TabName As String FieldName As String FieldPos As Integer FieldLen As Integer End Type '-Sub BubbleSortFields-------------------------------------------------- Sub BubbleSortFields(myArr() As FieldSpecs) '-Variables--------------------------------------------------------- Dim Done As Boolean Dim i As Integer, Min As Integer, Max As Integer Dim tempArr As FieldSpecs Min = LBound(myArr) Max = UBound(myArr) Do Done = True For i = Min + 1 To Max If (myArr(i - 1).FieldPos > myArr(i).FieldPos) Then tempArr = myArr(i - 1) myArr(i - 1) = myArr(i) myArr(i) = tempArr Done = False End If Next i Loop Until Done End Sub '-Sub GetTableDataFlex-------------------------------------------------- Sub GetTableDataFlex(TableName As String, Optional Options As String, _ Optional parRowCount As Long = 100) '-Variables--------------------------------------------------------- #If Win64 Then Dim SAP As Object #Else Dim SAP As CCo.COMNWRFC #End If Dim hRFC As Long, hFuncDesc As Long, hFunc As Long Dim hOptions As Long, hTableFields As Long, hTable As Long Dim hRow As Long, i As Long, j As Long, rowCount As Long Dim rc As Integer Dim charBuffer As String Dim Fields() As String Dim FieldSpec() As FieldSpecs Set SAP = CreateObject("COMNWRFC") If SAP Is Nothing Then Exit Sub End If hRFC = SAP.RfcOpenConnection("ASHOST=NSP, 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 '-Get field names of table------------------------------------------ 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", hTableFields) = RFC_OK Then hRow = SAP.RfcAppendNewRow(hTableFields) rc = SAP.RfcSetChars(hRow, "FIELDNAME", "TABNAME") hRow = SAP.RfcAppendNewRow(hTableFields) rc = SAP.RfcSetChars(hRow, "FIELDNAME", "FIELDNAME") hRow = SAP.RfcAppendNewRow(hTableFields) rc = SAP.RfcSetChars(hRow, "FIELDNAME", "POSITION") hRow = SAP.RfcAppendNewRow(hTableFields) rc = SAP.RfcSetChars(hRow, "FIELDNAME", "LENG") 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 rc = SAP.RfcDestroyFunction(hFunc) rc = SAP.RfcCloseConnection(hRFC) Set SAP = Nothing End If 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, "~") ReDim Preserve FieldSpec(i) FieldSpec(i).TabName = Fields(0) FieldSpec(i).FieldName = Fields(1) FieldSpec(i).FieldPos = Fields(2) FieldSpec(i).FieldLen = Fields(3) If i < rowCount Then rc = SAP.RfcMoveToNextRow(hTable) End If Next End If BubbleSortFields FieldSpec() For j = 1 To UBound(FieldSpec) If FieldSpec(j).FieldLen > 0 And FieldSpec(j).FieldLen <= 512 Then Tabelle1.Cells(1, j).Value = FieldSpec(j).FieldName End If Next rc = SAP.RfcDestroyFunction(hFunc) '-Get data from table column by column------------------------------ 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", TableName) rc = SAP.RfcSetInt(hFunc, "ROWCOUNT", parRowCount) For j = 1 To UBound(FieldSpec) '-If length of field = 0 Or > 512 skip---------------------------- If FieldSpec(j).FieldLen > 0 And FieldSpec(j).FieldLen <= 512 Then If SAP.RfcGetTable(hFunc, "FIELDS", hTableFields) = RFC_OK Then rc = SAP.RfcDeleteAllRows(hTableFields) hRow = SAP.RfcAppendNewRow(hTableFields) rc = SAP.RfcSetChars(hRow, "FIELDNAME", Trim(FieldSpec(j).FieldName)) End If If Not IsMissing(Options) Then If SAP.RfcGetTable(hFunc, "OPTIONS", hOptions) = RFC_OK Then rc = SAP.RfcDeleteAllRows(hOptions) hRow = SAP.RfcAppendNewRow(hOptions) rc = SAP.RfcSetChars(hRow, "TEXT", Options) End If End If If SAP.RfcInvoke(hRFC, hFunc) <> RFC_OK Then Exit For End If 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) Tabelle1.Cells(i + 1, j).Value = Trim(charBuffer) If i < rowCount Then rc = SAP.RfcMoveToNextRow(hTable) End If Next End If rc = SAP.RfcDeleteAllRows(hTable) End If Next rc = SAP.RfcDestroyFunction(hFunc) rc = SAP.RfcCloseConnection(hRFC) Set SAP = Nothing End Sub '-Sub Test1------------------------------------------------------------- Sub Test1() Dim TableName As String TableName = InputBox("Name of the transparent table") If TableName <> "" Then Tabelle1.UsedRange.ClearContents GetTableDataFlex TableName End If End Sub '-Sub Test2------------------------------------------------------------- Sub Test2() Dim Options As String Tabelle1.UsedRange.ClearContents Options = "OBJECT = 'COMM'" GetTableDataFlex "TADIR", Options End Sub '-End-------------------------------------------------------------------The sub routines Test1 and Test2 shows different forms of calls. Test1 loads a complete table, which name is given in the input box. Test2 loads table TADIR with the where clause OBJECT = ‘COMM’. The third parameter of GetTableDataFlex is ROWCOUNT, the standard is 100 to avoid long runtimes.
Enjoy it.
Cheers
Stefan
New NetWeaver Information at SAP.com
Very Helpfull
