SAP接口编程案例 - VBA批量更新销售订单定价类型

碰到一个需求，需要对销售订单的定价类型进行批量更新，对这种临时批量处理，考虑到数据源一般放在 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)

参考

更新销售订单执行新定价——BAPI_SALESORDER_CHANGE