VB连接SAP实例

最近做个项目有用到vb连接SAP，现在项目完成，做个技术总结。顺便整理了下VB连接SAP取回/传送数据

的方法。

1.连接SAP.

Public Function GetSAPConnection() As Object
    Dim strStatus As String
    Dim oFunction As Object
    Dim oConnection As Object
    Dim result As Boolean
    Set oFunction = CreateObject("SAP.LogonControl.1")
    Set oConnection = oFunction.NewConnection
   
    oConnection.client = "700"
    oConnection.language = "zh"
   
    oConnection.ApplicationServer = "172.16.0.23"  
    oConnection.user = "WMS001"                   
    oConnection.Password = "WMS001"               
    oConnection.SystemNumber = "03"              
    oConnection.codepage = "8400"
   
    result = oConnection.Logon(0, True)
    If result <> True Then
        Set oFunction = Nothing
        Set oConnection = Nothing
        Set GetSAPConnection = Nothing
        MsgBox "连接失败！"
    Else
'        MsgBox "连接成功！"
        Set GetSAPConnection = oConnection
    End If
End Function

2.取得SAP数据Example

'先声明全局变量
Dim sapCon As Object
Dim func As Object
Dim retSapData As Object  '返回的数据

-----------------------------
' 通过RFC接口远程运行SAP内部函数
Public Function GetSAPData() As Boolean

    'On Error GoTo LblErr

    Dim RFCName As String
    Dim RetTblName As String
    Dim RetTblName2 As String
    Dim ofun As Object
    Dim i As Integer

    Set sapCon = GetSAPConnection()
    Set ofun = CreateObject("SAP.FUNCTIONS")
    Set ofun.Connection = sapCon

 

    RFCName = "ZWMS_POST_DATA"

    ' 通过RFC接口远程运行SAP内部函数
    Set func = ofun.Add(RFCName)           ' 赋要调用的SAP内建函数名

 

a.传入RFC的参数为 值

    '设置参数
    Dim params(5, 1) As String
    '参数名
    params(0, 0) = "I_TCODE"
    params(1, 0) = "I_WERKS"
    params(2, 0) = "I_ORDNO"
    params(3, 0) = "I_CHECK_NOPOST"
    params(4, 0) = "I_CHECK_CANCEL"
    '参数值
    params(0, 1) = "ZMMJ06"
    params(1, 1) = "WX01"
    params(2, 1) = "K000025013"
    params(3, 1) = "X"
    params(4, 1) = "X"

      If Not IsEmpty(params) Then
        For i = 0 To 5
            func.Exports(CStr(params(i, 0))) = CStr(params(i, 1))
        Next
     End If

    RetTblName = "ET_MSEG"
    RetTblName2 = "ET_BATCH"

    If func.Call Then   '执行RFC函数
        Set retSapData = func.tables.Item(RetTblName)     '输出参数 为表
        MsgBox retSapData.rowcount          '返回的表记录数
 MsgBox retSapData(1, "MATNR_REAL")  '返回的表的第一条记录"MATNR_REAL"字段的值

        GetSAPData = True
    Else
        MsgBox func.Exception
        GetSAPData = False
    End If
    Exit Function
LblErr:
    MsgBox Err.Description, vbCritical
End Function

 

b.传入RFC的参数为 结构 （结构名 IS_DOC）

     func.Exports("IS_DOC").Value("ORDER") = "5000002"   ' 结构中的元素ORDER
     func.Exports("IS_DOC").Value("MATNR") = "51000001"   '结构中的元素MATNR
     If func.Call Then
        Set retSapData = func.tables.Item(RetTblName)     '输出参数 为表
        sMatnr2 = CStr(retSapData(1, "MATNR_REAL"))       '从输出表中取得需要值

     End If

c.传入RFC的参数为 表 （表名：T_MAT）

  '--------------------------------------
 1. 可以只传入一条表数据
  func.tables("T_MAT").Rows.Add
  func.tables("T_MAT").Value(1, "PROD_ORDER") = "5000002"
  func.tables("T_MAT").Value(1, "MATNR_IDEAL") = "51000000"
  func.tables("T_MAT").Value(1, "SWB002") = "82"
  func.tables("T_MAT").Value(1, "MATNR_REAL") = ""
  func.tables("T_MAT").Value(1, "MAKTX") = ""

  If func.Call Then
     Set retSapData = func.tables.Item(RetTblName)     '输出参数 为表
     sMatnr2 = CStr(retSapData(1, "MATNR_REAL"))       '从输出表中取得需要值
  End If
  '------------------------------------------------

  2. 整张表传入
    Do While Not objRs.EOF
        iRow = iRow + 1
        func.tables("T_MAT").Rows.Add
        func.tables("T_MAT").Value(iRow, "PROD_ORDER") = objRs.Fields(0).Value
        func.tables("T_MAT").Value(iRow, "MATNR_IDEAL") = objRs.Fields(1).Value
        func.tables("T_MAT").Value(iRow, "SWB002") = objRs.Fields(2).Value
        func.tables("T_MAT").Value(iRow, "MATNR_REAL") = ""
        func.tables("T_MAT").Value(iRow, "MAKTX") = ""
        objRs.MoveNext
    Loop

  If func.Call Then
     Set retSapData = func.tables.Item(RetTblName)     '输出参数 为表
     sMatnr2 = CStr(retSapData(1, "MATNR_REAL"))       '从输出表中取得需要值
  End If 

 

'   RFC的方法：
'   func.Exports("参数名")  输入参数
'   func.Imports("参数名")  SAP返回值

 

 

 

SAP提供的接口函数说明  

 

function name:ZMESSH_REAL_MATERIAL

 

FUNCTION ZMESSH_REAL_MATERIAL .

*"---------------------------------------------------------

*"*" 本地接口 :

*"  EXPORTING

*"     VALUE(E_SUBRC) TYPE  SY-SUBRC

*"     VALUE(E_MSG) TYPE  BAPI_MSG

*"  TABLES

*"      T_MAT STRUCTURE  ZMES_MAT

*"      ET_RETURN STRUCTURE  BAPIRET2 OPTIONAL

*"----------------------------------------------------------

 

1.输入参数

 

 

2. 返回参数

l          E_SUBRC 状态 0: 成功 其它失败

l          E_MSG   错误信息

3. 输入表

l          T_MAT  物料特性表 ( 有一部份栏位也输出)

1	ZMES_MAT				Mes 物料
NO	Field name	Data type	Length	Decimal	Memo	Memo
1	PROD_ORDER	CHAR	12	0	生产订单号	必输
2	MATNR_IDEAL	CHAR	18	0	计划物料号	必输
3	SWB002	DEC	13	3	组件功率	必输
4	MATNR_REAL	CHAR	18	0	产出物料号	计算完输出
5	MAKTX	CHAR	40	0	物料描述	计算完输出