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

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

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

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

不多说，上代码：

Option ExplicitPublic Sub test()    Call Logon    Call ReadTable("T030", Sheet1)    Call LogoffEnd 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 IfEnd Sub' 将itab转换成数组Private Function ItabToArray(itab As SAPTableFactoryCtrl.Table) As Variant    Dim arr() As Variant    arr = itab.data    ItabToArray = arrEnd FunctionPrivate 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 = dataSplittedEnd FunctionPrivate 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 = dataEnd Sub