Tip: How to soften RFC_READ_TABLE length restriction with Excel-VBA

[stefan_schnell]

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.