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 物料特性表 ( 有一部份栏位也输出)