SAP RFC_READ_TABLE functionality in HAMMER

The code below is a typical VBA routine used to fetch data from SAP into Excel.

It uses the “SAP.Functions” COM object as exposed by the SAP GUI Client, fetching the data via RFC_READ_TABLE; an automated SE16 in effect.

The credentials required are the same as those you would use to log into your desktop client, and whatever internal tables you can see via SE16, those same tables will be fetchable via RFC_READ_TABLE.

This automated fetching of data is ideal when some self-service reporting is a requirement (you know, standard DW extracts offer most of what you need, but there’s always something missing 🙂 ).

I figured this would be a good candidate as a HAMMER command. Not just to take advantage of HAMMER’s natural table handling but also its multi-threading capability. Being able to spawn one or more background threads (or delegate to HAMMER.exe command line process(es) ) would be very handy for SAP datasmiths.

Problem is, the code below works, and I’ve converted it to VB.NET, made it more generic and added it as a HAMMER command; but I can’t test it, as I no longer have access to a SAP R3 Instance!

The command SAPREADTABLE takes three parameters:

  • a CSV list of SAP logon credentials: System,Client,User,Password,Language
  • a CSV list of table information, 1st argument the table name, the rest field names e.g. KNA1,KUNNR,NAME1,NAME2,LAND1
  • a filter statement (like a SQL where) e.g. LAND1 in (‘DE’,’NL’)

Example:

“Test SYS,600,tom,pwd,EN”,”KNA1,KUNNR,NAME1″,”LAND1 = ‘DE'”

UPDATE: April 29, 2012

Could somebody with access to SAP R3 test this out for me?  Done, tested (found a small bug, now fixed) and working (thanks to a kind person who allowed me access to a test server, you know who are, thanks again).

Fetch the modified latest version below (fixed bug that produced an extra blank column and extra blank row in result table, my typical “1 off” bug when converting from VBA to VB.NET, obviously I’ll never learn 🙂 )

If you get a scary “ABEND – SYSTEM FAILURE” error, don’t panic you haven’t broken the company ERP system, it’s usually due to a malformed filter statement e.g. LAND1=’NL’ (no spaces) rather than LAND1 = ‘NL’.

To download the latest version of the code, go to this page on my website.

Follow the HAMMER tag on  this blog for information on commands and examples (best start with the oldest and work forward …)

Need a pure VBA version, here it is :

SAP RFC_READ_TABLE VBA Example:


Option Explicit
Option Base 0

Public Function RFC_READ_TABLE(tableName, columnNames, filter)

Dim R3 As Object, MyFunc As Object, App As Object

' Define the objects to hold IMPORT parameters
Dim QUERY_TABLE As Object
Dim DELIMITER   As Object
Dim NO_DATA     As Object
Dim ROWSKIPS    As Object
Dim ROWCOUNT    As Object
' Where clause
Dim OPTIONS As Object
' Fill with fields to return.  After function call will hold
' detailed information about the columns of data (start position
' of each field, length, etc.
Dim FIELDS  As Object
' Holds the data returned by the function
Dim DATA    As Object
' Use to write out results
Dim ROW As Object

Dim Result As Boolean
Dim i As Long, j As Long, iRow As Long
Dim iColumn As Long, iStart As Long, iStartRow As Long, iField As Long, iLength As Long
Dim outArray, vArray, vField
Dim iLine As Long
Dim noOfElements As Long

'**********************************************
'Create Server object and Setup the connection
'use same credentials as SAP GUI login
On Error GoTo abend:
  Set R3 = CreateObject("SAP.Functions")
  R3.Connection.SYSTEM = ""
  R3.Connection.Client = ""
  R3.Connection.User = ""
  R3.Connection.Password = ""
  R3.Connection.Language = "EN"

  If R3.Connection.logon(0, True) <> True Then
   RFC_READ_TABLE = "ERROR - logon to SAP Failed"
   Exit Function
  End If
'**********************************************

'*****************************************************
'Call RFC function RFC_READ_TABLE
'*****************************************************

  Set MyFunc = R3.Add("RFC_READ_TABLE")
   Set QUERY_TABLE = MyFunc.exports("QUERY_TABLE")
   Set DELIMITER = MyFunc.exports("DELIMITER")
   Set NO_DATA = MyFunc.exports("NO_DATA")
   Set ROWSKIPS = MyFunc.exports("ROWSKIPS")
   Set ROWCOUNT = MyFunc.exports("ROWCOUNT")

   Set OPTIONS = MyFunc.Tables("OPTIONS")
   Set FIELDS = MyFunc.Tables("FIELDS")

   QUERY_TABLE.Value = tableName
   DELIMITER.Value = ""
   NO_DATA = ""
   ROWSKIPS = "0"
   ROWCOUNT = "0"
   OPTIONS.Rows.Add
   OPTIONS.Value(1, "TEXT") = filter ' where filter

    vArray = Split(columnNames, ",") ' columns
    j = 1
    For Each vField In vArray
        If vField <> "" Then
            FIELDS.Rows.Add
            FIELDS.Value(j, "FIELDNAME") = vField
            j = j + 1
        End If
    Next

   Result = MyFunc.CALL

   If Result = True Then
     Set DATA = MyFunc.Tables("DATA")
     Set FIELDS = MyFunc.Tables("FIELDS")
     Set OPTIONS = MyFunc.Tables("OPTIONS")
     R3.Connection.LOGOFF
   Else
     R3.Connection.LOGOFF
     MsgBox MyFunc.EXCEPTION
     Exit Function
   End If

  noOfElements = FIELDS.ROWCOUNT
  iRow = 0
  iColumn = 0
  ReDim outArray(0 To DATA.ROWCOUNT, 0 To noOfElements - 1)
  For Each ROW In FIELDS.Rows
    outArray(iRow, iColumn) = ROW("FIELDNAME")
    iColumn = iColumn + 1
  Next

'Display Contents of the table
'**************************************
iRow = 1
iColumn = 1

For iLine = 1 To DATA.ROWCOUNT

       For iColumn = 1 To FIELDS.ROWCOUNT
         iStart = FIELDS(iColumn, "OFFSET") + 1
    '       If this is the last column, calculate the length differently than the other columns
         If iColumn = FIELDS.ROWCOUNT Then
            iLength = Len(DATA(iLine, "WA")) - iStart + 1
         Else
             iLength = FIELDS(iColumn + 1, "OFFSET") - FIELDS(iColumn, "OFFSET")
        End If
    '       If the fields at the end of the record are blank, then explicitly set the value
        If iStart > Len(DATA(iLine, "WA")) Then
             outArray(iRow, iColumn - 1) = Null
        Else
            outArray(iRow, iColumn - 1) = Mid(DATA(iLine, "WA"), iStart, iLength)
        End If

       Next

       iRow = iRow + 1
Next

RFC_READ_TABLE = outArray
Exit Function

abend:

RFC_READ_TABLE = Err.Description

End Function

Public Sub Paste_sheet1()
Dim lArray
Dim lAdjust As Long

lArray = RFC_READ_TABLE("KNA1", "KUNNR,NAME1,NAME2", "LAND1 = 'DE'")
If TypeName(lArray) = "String" Then
    MsgBox "Problem calling RFC is it here " & CStr(lArray)
Else

    ' adjust if zero based array
        If LBound(lArray, 1) = 0 Then lAdjust = 1 Else lAdjust = 0

    [Sheet1!A1].Resize(UBound(lArray, 1) + lAdjust, UBound(lArray, 2) + lAdjust) = lArray

End If

End Sub

Advertisements

Comments are closed.