碰到一个需求，需要对销售订单的定价类型进行批量更新，对这种临时批量处理，考虑到数据源一般放在 Excel 中，使用 VBA 来调用 BAPI 实现不失为一种快捷的方式。
了解 BAPI 如何使用
更改销售订单的 BAPI 是 BAPI_SALESORDER_CHANGE，这个 BAPI 因为参数比较多，我们首先要找到针对更改定价类型这种场景，相应的参数如何设置。基本方法就是 SE37 进行测试，以及查看函数的文档。
经过查找和测试，了解到需要更新定价类型需要填写如下的参数：
ORDER_HEADER_INX 的 UPDATEFLAG 参数要填写 U:
LOGIC_SWITCH 参数的 PRICING 是核心，这里填写要更新的定价类型。可以在 VA02 界面行项目的条件选项卡中查看。
当然要告诉 BAPI, 需要修改的行项目，需要填写 ORDER_ITEM_IN 和 ORDER_ITEM_INX 两个参数：
查看测试结果：
有了这些准备，可以编写程序了。
编写函数调用 BAPI_SALESORDER_CHANGE
因为本篇是讲解 RFC 的案例，所以并不详细说明 VBA 调用 BAPI 的要点和语法。之前我写过系列文章，小伙伴们可以自行查找。我将函数的调用封装在函数中，返回值为 BAPI 的 RETURN 参数：
Public Function ChangeSalesOrder(OrderNo As String, ItemNo As Integer, NewPricing As String) As String
Dim functions As New SAPFunctionsOCX.SAPFunctions
Dim func As SAPFunctionsOCX.Function
Dim commitFunc As SAPFunctionsOCX.Function
Dim orderItemIn As SAPTableFactoryCtrl.Table
Dim orderItemInX As SAPTableFactoryCtrl.Table
Dim returnTable As SAPTableFactoryCtrl.Table
Dim retVal As String '函数返回只
retVal = ""
' sapConnection is global
If sapConnection Is Nothing Then
MsgBox "请登录SAP系统!", vbOKOnly + vbInformation
Exit Function
End If
If sapConnection.IsConnected <> tloRfcConnected Then
MsgBox "请登录SAP系统!", vbOKOnly + vbInformation
Exit Function
End If
Set functions.Connection = sapConnection
Set func = functions.Add("BAPI_SALESORDER_CHANGE")
' BAPI参数-Importing
func.Exports("SALESDOCUMENT").Value = OrderNo ' 销售订单号
func.Exports("ORDER_HEADER_INX").Value("UPDATEFLAG") = "U" ' U表示修改
' BAPI参数-Pricing(在LOGIC_SWITCH参数中)
func.Exports("LOGIC_SWITCH").Value("PRICING") = NewPricing
func.Exports("LOGIC_SWITCH").Value("COND_HANDL") = "X"
'BAPI参数-ORDER_ITEM_IN / ORDER_ITEM_IN
Set orderItemIn = func.Tables("ORDER_ITEM_IN")
Set orderItemInX = func.Tables("ORDER_ITEM_INX")
orderItemIn.AppendRow
orderItemIn.Value(1, "ITM_NUMBER") = ItemNo
orderItemInX.AppendRow
orderItemInX.Value(1, "ITM_NUMBER") = ItemNo
orderItemInX.Value(1, "UPDATEFLAG") = "U"
'BAPI参数-返回值
Set returnTable = func.Tables("RETURN")
'执行函数
If func.Call = False Then
retVal = DumpReturn(returnTable)
Exit Function
Else
retVal = DumpReturn(returnTable)
Dim returnOfCommit As SAPTableFactoryCtrl.Table
Set commitFunc = functions.Add("BAPI_TRANSACTION_COMMIT")
commitFunc.Exports("WAIT").Value = "X"
Set returnOfCommit = commitFunc.Tables("RETURN")
If commitFunc.Call = False Then
MsgBox func.Exception
Exit Function
End If
End If
ChangeSalesOrder = retVal
End Function
注意该 BAPI 需要在调用之后，根据是否成功，再调用另外一个 BAPI : BAPI_TRANSACTION_COMMIT 来实现真正的提交。
处理函数的返回值
函数的返回值 return 是一个表类型的参数，我们可以有两种方式来处理，第一种方式是将每一行的消息都返回：
Private Function DumpReturn(ret As SAPTableFactoryCtrl.Table) As String
Dim i As Integer
Dim retVal As String
retVal = ""
Dim returnOfLine As String
If Not ret Is Nothing Then
If ret.rowcount > 0 Then
For i = 1 To ret.rowcount
returnOfLine = "消息" & Str(i) & ": " & ret.Value(i, 1) & "," & ret.Value(i, 4) & ";"
retVal = retVal & returnOfLine
Next i
End If
End If
DumpReturn = retVal
End Function
简便起见，我们也可以只获取 return 表参数的最后一行：
Private Function DumpReturn(ret As SAPTableFactoryCtrl.Table) As String
Dim retVal As String
retVal = ""
If Not ret Is Nothing Then
If ret.rowcount > 0 Then
retVal = "消息类型 " & ret.Value(ret.rowcount, 1) & "," & ret.Value(ret.rowcount, 4)
End If
End If
DumpReturn = retVal
End Function
实现从 Excel 中读取数据，然后进行批量更新
Public Sub RunScript()
Dim i As Long
Dim returnVal As String
For i = 4 To Sheet3.UsedRange.rows.Count
If Sheet3.Range("A" & i).Value = "EOF" Then Exit Sub
Dim leftCell As Range
Set leftCell = Sheet3.Range("A" & i)
returnVal = ChangeSalesOrder(leftCell.Value, leftCell.Offset(0, 1).Value, leftCell.Offset(0, 2).Value)
leftCell.Offset(0, 3).Value = returnVal
Next
在界面中进行测试：
源码
sap_interface_prog_rfc_vba: RFC programing using VBA (gitee.com)
