SAP接口编程-RFC系列07 : 通用的数据库表读取

实现通用的数据库表读取功能

上一篇讲的是调用 RFC_READ_TABLE 查看 SAP table 的数据。为了方便查看数据，我们可以写一个通用的表查看程序。使用起来比 SAP SE11 或 SE16N 方便点。

本篇没有关于 RFC 调用新的知识点。主要说明函数调用后，VBA 如何处理这些数据并在 Excel 中显示。不熟悉 VBA 的读者可以参考。由于 VBA 本身数据结构的限制，处理过程还是蛮啰嗦的。后续用C#调用的代码会方便很多。

不多说，上代码：

Option Explicit

Public Sub test()
    Call Logon
    Call ReadTable("T030", Sheet1)
    Call Logoff
End Sub

''''''''''''''''''''''''''''''''''''''''''''''
'读取tableName的数据，写入inSheet这个工作表
''''''''''''''''''''''''''''''''''''''''''''''
Private Sub ReadTable(tableName As String, inSheet As Worksheet)
    Dim functions As SAPFunctions
    Set functions = New SAPFunctions
    Dim fm As SAPFunctionsOCX.Function
    
    ' RFC_READ_TABLE的三个table型参数
    Dim optionsTable As SAPTableFactoryCtrl.Table
    Dim dataTable As SAPTableFactoryCtrl.Table
    Dim fieldsTable As SAPTableFactoryCtrl.Table
    
    Dim delimeter As String
    delimeter = "~" '长度只能为1
    
    If sapConnection Is Nothing Then Exit Sub
    Set functions.Connection = sapConnection
   
    If sapConnection.IsConnected = tloRfcConnected Then
        'FM加到functions collection
        Set fm = functions.Add("RFC_READ_TABLE")
        
        '------------------------
        '填充Import parameters
        '------------------------
        'QUERY_TABLE是要查找的表名
        fm.Exports("QUERY_TABLE").Value = tableName 'Table name
        
        'DELIMITER是输出时字段的分割符
        fm.Exports("DELIMITER").Value = delimeter

        Set optionsTable = fm.Tables("OPTIONS")  'OPTIONS是筛选条件
        Set fieldsTable = fm.Tables("FIELDS")    'FIELDS表示要输出的列
        Set dataTable = fm.Tables("DATA")        'DATA为输出的数据
        
        fm.Call
        
        '如果有Exception,说明有错误产生
        If fm.Exception <> "" Then
            Debug.Print fm.Exception
            Exit Sub
        End If
        
        ' 存储fields信息的数组
        Dim fields() As Variant
        fields = ItabToArray(fieldsTable)
        
        ' 存储data信息的数组
        Dim data() As Variant
        data = ItabToArray(dataTable)
        
        ' 将data分割
        Dim splittedData() As Variant
        splittedData = splitData(data, delimeter)
        
        ' 为了Excel显示需要，将数据加上"'", Excel显示为字符型
        Dim r As Long
        Dim c As Long
        For r = 1 To UBound(splittedData, 1)
            For c = 1 To UBound(splittedData, 2)
                splittedData(r, c) = "'" + splittedData(r, c)
            Next
        Next
        
        ' 将field name, field text和data整合到一个工作表显示
        Call WriteData(fields, splittedData, Sheet1)
    End If
End Sub


' 将itab转换成数组
Private Function ItabToArray(itab As SAPTableFactoryCtrl.Table) As Variant
    Dim arr() As Variant
    arr = itab.data
    
    ItabToArray = arr
End Function


Private Function splitData(data() As Variant, delimeter As String) As Variant
    Dim dataSplitted() As Variant '返回值
    
    Dim rowcount As Long
    rowcount = UBound(data, 1)
   
    ' 列数需要计算
    Dim testcol As Variant
    testcol = Split(data(1, 1), delimeter) '根据第一个数据来确定列数
    
    Dim colcount As Long
    colcount = UBound(testcol) + 1
    ReDim dataSplitted(1 To rowcount, 1 To colcount)
    
    Dim line As Variant
    Dim r As Long
    Dim c As Long
    For r = 1 To rowcount
        line = Split(data(r, 1), delimeter) ' line 从0开始
        For c = 1 To colcount
            dataSplitted(r, c) = line(c - 1)
        Next
    Next
    
    splitData = dataSplitted
End Function


Private Sub WriteData(fields() As Variant, data() As Variant, inSheet As Worksheet)
    ' Clear first
    inSheet.Cells.ClearContents
    
    Dim fieldname() As Variant
    Dim fieldtext() As Variant
    
    Dim rowcount As Integer
    rowcount = UBound(fields, 1)
    ReDim fieldname(1 To rowcount)
    ReDim fieldtext(1 To rowcount)
    
    Dim r As Integer
    For r = 1 To UBound(fields, 1)
        fieldname(r) = fields(r, 1) ' 第一列为fieldname
        fieldtext(r) = fields(r, 5) ' 第五列为fieldtext
    Next
    
    ' fieldname和fieldtext写入工作表
    ' 第一行fieldname
    Dim fieldNameRange As Range
    Set fieldNameRange = inSheet.Range("A1")
    fieldNameRange.Resize(1, UBound(fieldname)).Value = fieldname
    
    ' 第二行fieldtext
    Dim fieldTextRange As Range
    Set fieldTextRange = inSheet.Range("A2")
    fieldTextRange.Resize(1, UBound(fieldname)).Value = fieldtext
    
    ' 从第三行开始，将splitted data写入工作表
    Dim dataRange As Range
    Set dataRange = inSheet.Range("A3")
    dataRange.Resize(UBound(data, 1), UBound(data, 2)).Value = data
End Sub