[分享]一段VBA调用RFC的代码

Sub retrieve_table_contents()

Dim R3, MyFunc, App As Object
Dim SEL_TAB, NAMETAB, TABENTRY, ROW As Object
Dim Result As Boolean
Dim iRow, iColumn, iStart, iStartRow As Integer

iStartRow = 4

Worksheets(1).Select
Cells.Clear

'**********************************************
'Create Server object and Setup the connection
'**********************************************
Set R3 = CreateObject("SAP.Functions")
R3.Connection.System = "denmark"
R3.Connection.client = "250"
R3.Connection.user = "CLAYTONM"
R3.Connection.password = ""
R3.Connection.language = "EN"

If R3.Connection.logon(0, False) <> True Then
   Exit Sub
End If

'*****************************************************
'Call RFC function TABLE_ENTRIES_GET_VIA_RFC
'*****************************************************
Set MyFunc = R3.Add("TABLE_ENTRIES_GET_VIA_RFC")

Dim oParam1 As Object
Dim oParam2 As Object
Dim oParam3 As Object

Set oParam1 = MyFunc.exports("LANGU")
Set oParam2 = MyFunc.exports("ONLY")
Set oParam3 = MyFunc.exports("TABNAME")

oParam1.Value = "E"
oParam2.Value = ""
oParam3.Value = frmQuery.txtTableName

Result = MyFunc.CALL

If Result = True Then
  Set NAMETAB = MyFunc.Tables("NAMETAB")
  Set SEL_TAB = MyFunc.Tables("SEL_TAB")
  Set TABENTRY = MyFunc.Tables("TABENTRY")
Else
    MsgBox MyFunc.EXCEPTION
    R3.Connection.LOGOFF
    Exit Sub
End If

'Result = R3.TABLE_ENTRIES_GET_VIA_RFC(EXCEPTION, LANGU:="E", ONLY:="", TABNAME:=frmQuery.txtTableName, SEL_TAB:=SEL_TAB, NAMETAB:=NAMETAB, TABENTRY:=TABENTRY)

'*******************************************
'Quit the SAP Application
'*******************************************
R3.Connection.LOGOFF

If Result <> True Then
  MsgBox (EXCEPTION)
  Exit Sub
End If

'**************************************
'Display table header
'**************************************
iColumn = 1

For Each ROW In NAMETAB.Rows
    Cells(iStartRow - 1, iColumn) = ROW("FIELDNAME")
'   For C and N datatypes, explicitly set the cell to TEXT format, otherwise leading zeroes will be lost
'   when numbers are imported from a SAP text field
    If ROW("INTTYPE") = "C" Or ROW("INTTYPE") = "N" Then
        Range(Cells(iStartRow - 1, iColumn), Cells(iStartRow - 1 + TABENTRY.Rowcount, iColumn)).Select
        Selection.NumberFormat = "@"
    End If
    Cells(iStartRow, iColumn) = ROW("FIELDTEXT")
    iColumn = iColumn + 1
Next

Range(Cells(iStartRow - 1, 1), Cells(iStartRow, NAMETAB.Rowcount)).Font.Bold = True

'**************************************
'Display Contents of the table
'**************************************
iColumn = 1
For iRow = iStartRow + 1 To TABENTRY.Rowcount
    For iColumn = 1 To NAMETAB.Rowcount
        iStart = NAMETAB(iColumn, "OFFSET") + 1
'       If this is the last column, calculate the length differently than the other columns
        If iColumn = NAMETAB.Row_count Then
            iLength = Len(TABENTRY(iRow, "ENTRY")) - iStart
        Else
            iLength = NAMETAB(iColumn + 1, "OFFSET") - NAMETAB(iColumn, "OFFSET")
        End If
'       If the fields at the end of the record are blank, then explicitly set the value
        If iStart > Len(TABENTRY(iRow, "ENTRY")) Then
            Cells(iRow, iColumn) = Null
        Else
            Cells(iRow, iColumn) =_ mid(TABENTRY(iRow, "ENTRY"), iStart, iLength)
        End If
    Next
Next

'*******************************************
'Format the Columns
'*******************************************
Range(Cells(iStartRow, 1), Cells(iStartRow + TABENTRY.Rowcount, NAMETAB.Rowcount)).Select
Selection.EntireColumn.AutoFit

End Sub