代碼及說明

Option Explicit

Dim sapLogon As SAPLogonCtrl.SAPLogonControl
Dim sapConn As SAPLogonCtrl.Connection

Public Sub Logon()
    Set sapLogon = New SAPLogonControl
    Set sapConn = sapLogon.NewConnection

    sapConn.Logon 0, False
End Sub

Public Sub Logoff()
    If sapConn.IsConnected = tloRfcConnected Then
        sapConn.Logoff
    End If
End Sub

Public Sub GetCoCdList()
    Dim functions As SAPFunctionsOCX.SAPFunctions
    Dim fm As SAPFunctionsOCX.Function
    Dim cocdDetail As SAPTableFactoryCtrl.Table

    Call Logon

    Set functions = New SAPFunctions
    Set functions.Connection = sapConn

    ' FM加入Functions集合'
    Set fm = functions.Add("BAPI_COMPANYCODE_GETLIST")

    fm.Call

    '得到Table參數(shù)'
    Set cocdDetail = fm.Tables("COMPANYCODE_LIST")

    ' 打印出公司代碼的名稱'
    Dim row As Integer
    For row = 1 To cocdDetail.RowCount
        Debug.Print cocdDetail.Value(row, "COMP_NAME")
    Next

    Call Logoff
End Sub

因?yàn)閏ocdDetail是一個(gè)二維表，所以使用遍歷的方式取得所有公司代碼的列表。為了更具一般性，我們可以寫一個(gè)通用的routine，將internal table輸出到Excel單元格。

Public Sub WriteTable(itab As SAPTableFactoryCtrl.Table, sht As Worksheet)
    Dim col As Long          ' column index
    Dim row As Long          ' row index
    Dim headerRange As Variant  '在Excel中根據(jù)itab的header大小，類型為Variant數(shù)組
    Dim itemsRange As Variant   '在Excel中根據(jù)itab的行數(shù)和列數(shù)，類型為Variant數(shù)組

    If itab.RowCount = 0 Then Exit Sub

    '-------------------------------------------------'
    ' 取消Excel的屏幕刷新和計(jì)算功能以加快速度'
    '-------------------------------------------------'
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    ' 清除cells的內(nèi)容'
    sht.Cells.ClearContents

    '------------------------------'
    ' 將Table的Header寫入Worksheet'
    '------------------------------'

    ' 根據(jù)內(nèi)表的列數(shù)，使用Range創(chuàng)建一個(gè)數(shù)組'
    Dim headerstarts As Range
    Dim headerends As Range
    Set headerstarts = sht.Cells(1, 1)
    Set headerends = sht.Cells(1, itab.ColumnCount)

    headerRange = sht.Range(headerstarts, headerends).Value

    ' 將內(nèi)表列名寫入數(shù)組'
    For col = 1 To itab.ColumnCount
        headerRange(1, col) = itab.Columns(col).Name
    Next

    ' 從數(shù)組一次性寫入Excel，這樣效率較高'
    sht.Range(headerstarts, headerends).Value = headerRange

    '-------------------------------'
    ' 將Table的行項(xiàng)目寫入Worksheet'
    '-------------------------------'

    ' 根據(jù)內(nèi)表的大小,使用Range創(chuàng)建數(shù)組'
    Dim itemStarts As Range
    Dim itemEnds As Range

    Set itemStarts = sht.Cells(2, 1)
    Set itemEnds = sht.Cells(itab.RowCount + 1, itab.ColumnCount)

    itemsRange = itab.Data

    ' 一次性將數(shù)組寫入Worksheet'
    sht.Range(itemStarts, itemEnds).Value = itemsRange

    '---------------------------------'
    ' 恢復(fù)Excel的屏幕刷新和計(jì)算'
    '---------------------------------'
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

有了以上通用routine，程序可以簡化為：

Public Sub GetCompanyCodeList()
    Dim functions As SAPFunctionsOCX.SAPFunctions
    Dim fm As SAPFunctionsOCX.Function

    Dim cocdDetail As SAPTableFactoryCtrl.Table

    If sapConnection Is Nothing Or sapConnection.IsConnected <> tloRfcConnected Then
        MsgBox "沒有連接到目標(biāo)SAP系統(tǒng)，請(qǐng)先建立連接!", vbExclamation
        Exit Sub
    End If

    Set functions = New SAPFunctions
    Set functions.Connection = sapConnection 

    ' FM加入Functions集合'
    Set fm = functions.Add("BAPI_COMPANYCODE_GETLIST")

    fm.Call

    '通過Table參數(shù)獲得company code details'
    Set cocdDetail = fm.Tables("COMPANYCODE_LIST")

    ' Table輸出至Sheet1'
    Call WriteTable(cocdDetail, Sheet1)
End Sub