Option Explicit

Public Function BAPI_CALL()

' --------------------------------------------------------------
' 変数宣言部
' --------------------------------------------------------------

Dim R3                  As Object ' R/3接続用
Dim objRequisitions     As Object ' BAPI実行用

' BAPI用変数(実行するBAPI依存)
Dim objRequisitionItems As Object
Dim objReturn           As Object


'---------------------------------------------------------------
'R/3 への接続処理
'---------------------------------------------------------------

' 接続のパラメータ入力
Set R3 = CreateObject("SAP.BAPI.1")           ' 決まり文句(BAPI用)
R3.Connection.ApplicationServer = ServerAddr  ' xxx.xxx.xxx.xxx など
R3.Connection.Client            = ClientNum   ' クライアント番号
R3.Connection.User              = UserID      ' ユーザID
R3.Connection.Password          = Password    ' ログインパスワード
R3.Connection.Language          = "JA"        ' 言語

' ログイン実行
If R3.Connection.Logon(0, True) <> True Then
    MsgBox "R/3 ログインに失敗しました"
    Exit Function
End If

'---------------------------------------------------------------
'BAPI(購買依頼の作成) 実行
'---------------------------------------------------------------

On Error GoTo LOGOUT                           ' 以下でエラーが発生したらログアウト

' ※ Set関数を利用し、各値に簡単にアクセス出来るようにする

' ビジネスオブジェクト：PurchaseRequisition を作成する
' (BAPIエクスプローラで調査し、購買依頼作成メソッドはここに所属することが判明)
Set objRequisitions = R3.GetSAPObject("PurchaseRequisition")

' 実行するメソッドの引数を作成する
' なお DimAs() の引数は左から、BO、メソッド名、生成したい引数名、となる
Set objRequisitionItems = R3.DimAs(objRequisitions, "CreateFromData", "RequisitionItems")    
Set objReturn           = R3.DimAs(objRequisitions, "CreateFromData", "RequisitionItems")

' 各パラメータに値を設定する(とりあえず必要最低限のみ)
' 明細１行のみを作成
' データはSheet1のセルに入力されていると想定
' なおセルの書式を指定しておくなどし、データの型(String/Integer/Dateなど)を
' BAPI側と合わせないと、ここで処理が落ちるので注意すること
'
With objRequisitionItems
    .Rows.Add
    .Value(1, "DOC_TYPE")   = Sheet1.Cells(1, 1)
    .Value(1, "PREQ_ITEM")  = Sheet1.Cells(2, 1)
    .Value(1, "MATERIAL")   = Sheet1.Cells(3, 1)
    .Value(1, "PLANT")      = Sheet1.Cells(4, 1)
    .Value(1, "QUANTITY")   = Sheet1.Cells(5, 1)
    .Value(1, "DELIV_DATE") = Sheet1.Cells(6, 1)
End With

' BAPI（購買依頼登録）の実行
objRequisitions.CreateFromData _
                    RequisitionItems:=objRequisitionItems, _
                    Return          :=objReturn

' 実行結果の成否判定(この戻り値もBAPI側の定義依存)
Dim ret_message As String
ret_message = ""
If objReturn.ROWCOUNT > 0 Then
    With objReturn
        ' エラーコード＋メッセージを表示する
        ret_message = Value(1, "CODE") & " " & .Value(1, "MESSAGE")
    End With
End If

If ret_message <> "" Then
    MsgBox ret_message
Else
    ' エラーが無かったので 購買依頼番号を表示して終了する
    MsgBox "購買依頼を登録しました：No. " & Format(objRequisitions.Number, "0000000000")
End If

LOGOUT:

' 値の確保も終わったので接続は終了する
R3.Connection.Logoff


End Function