Skip to Content

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

To report this post you need to login first.

Be the first to leave a comment

You must be Logged on to comment or reply to a post.

Leave a Reply