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