前回の記事では、SAP OData V4 API「API_PURCHASEORDER_2」をExcelマクロ（VBA）から呼び出し、購買発注データを取得（GET）する方法を解説した。
GETでデータを読み込めるようになったなら、次のステップはいよいよデータの登録（POST）だ。
「SAPのデータをExcelから直接登録できたら、どれだけ業務が楽になるか」
そう感じたことのある方は多いはずだ。手入力によるミス、二重登録のリスク、そして何より時間のロス。
こうした悩みを一気に解消してくれるのが、SAP OData API + Excelマクロ（VBA） による自動登録の仕組みだ。
本記事では、SAP OData V4「API_PURCHASEORDER_2」＋Excel VBAを使って、購買発注（Purchase Order）をSAPへ登録する実装方法を、実際に動作するVBAコードとともに徹底解説する。
コードの言語はVBAだが、プログラムの構造はPython・JavaScriptなど他言語でも共通しているため、言語を問わず参考になるはずだ。
SAP OData と Excel VBA によるSAPデータ登録に興味がある方は、ぜひ最後まで読んでほしい。
GETの次はPOST ─ SAP OData 購買発注登録
ODataを使ったSAP連携の第一歩は「データを読む（GET）」ことだ。当ブログでも、ODataをABAPおよびExcelマクロから呼び出し、SAPシステムのでデータを取得する方法を解説した。
業務自動化の本番はここからだ。
データを書き込む（POST）ことができて初めて、SAPとExcelの間に双方向のデータフローが生まれ、実務で使える仕組みとなる。
GETとPOSTでは、実装の難易度が大きく異なる。GETはURLを叩けばデータが返ってくるシンプルな仕組みだが、POSTではリクエスト本文（JSON）を正しく組み立て、さらにCSRFトークンという認証情報も付与しなければならない。
以下にGETとPOSTの主な違いをまとめた。
| 項目 | GET | POST |
|---|---|---|
| 主目的 | データを取得する | データを新規登録する |
| SAP OData例 | POを読む | POを新規作成する |
| リクエスト本文 | 通常なし | 必要（JSON形式） |
| CSRFトークン | 原則不要 | 必要 |
| データ変更 | しない | する |
| 成功時ステータス | 200など | 200 / 201 / 204など |
GETと比べてPOSTは
- リクエスト本文をJSONで組み立てる
- CSRFトークンを取得してヘッダに付与する
という2つのステップが追加される。しかし、この2点さえ押さえてしまえば、あとは難しくない。
順を追って解説していこう。
SAP OData V4「API_PURCHASEORDER_2」とは
「API_PURCHASEORDER_2」は、SAP S/4HANAが標準提供するOData V4サービスのひとつで、購買発注（Purchase Order）に関するCRUD操作（作成・読取・更新・削除）を RESTful API として公開したものだ。
SAPのAPI BusinessHubでも公開されており、外部システムやExcelマクロから標準インターフェースとして利用できる。
OData V4はOData V2と比べて、JSONファーストな設計になっており、レスポンスの構造がシンプルだ。
SAP S/4HANAのBTP（Business Technology Platform）との親和性も高く、今後の標準として積極的に採用されている。
本記事で扱うエンドポイントは以下の通りだ。
このパスに対してPOSTリクエストを送ることで、SAP上に購買発注を新規登録することができる。
GETとPOSTの違いを整理する
GETはデータの取得専用であり、SAPのデータを一切変更しない安全な操作だ。
一方、POSTはSAP上にデータを新規作成する書き込み操作であるため、より厳格な認証が求められる。
特に重要なのが CSRFトークン（Cross-Site Request Forgery Token）だ。SAPの OData API は POST・PUT・DELETEなどのデータ変更操作に対して、CSRFトークンによるリクエスト正当性の確認を要求する。
これはセキュリティ上の仕組みであり、事前にGETリクエストでトークンを取得し、その値をPOSTリクエストのヘッダに付与しなければ、リクエストが弾かれてしまう。
また、POSTが成功した際のHTTPステータスコードは、サーバの設定や実装によって200・201・204のいずれかが返ってくる場合がある。GETのように「200ならOK」という単純な判定では不十分で、この点も実装上のポイントとなる。
Excelシートの準備 ─ SAP OData 購買発注登録の準備
VBAコードを書く前に、まずExcelシート上のデータ構造を把握しておこう。データの持ち方を正しく設計することが、後のJSON組み立てをスムーズにする。
今回使用するサンプルデータは以下の構成だ。
| 列 | ヘッダ／明細 | 項目名 | サンプル値 |
|---|---|---|---|
| A | 購買発注ヘッダ | 購買伝票タイプ | NB |
| B | 仕入先勘定コード | V001 | |
| C | 購買伝票日付 | 2026/5/1 | |
| D | 購買組織 | A111 | |
| E | 購買グループ | A11 | |
| F | 会社コード | A111 | |
| G | 通貨コード | USD | |
| H | 購買発注明細 | 明細番号 | 10 / 20 |
| J | 品目コード（18桁） | RM1A111 | |
| K | テキスト（短） | TEST1 | |
| L | 購買発注量 | 1 | |
| M | 数量単位 | PC | |
| N | プラント | A111 | |
| O | 保管場所 | 1000 | |
| P | 納入日程行番号 | 1 / 2 | |
| Q | 納入日付 | 2026/9/25 | |
| R | 計画数量 | 1 | |
| S | 購買発注番号（出力） | 5000000087 |
ヘッダと明細 ─ SAPデータの典型パターン
SAPのデータ構造を理解する上で外せないのが、ヘッダ（Header）と明細（Item）の親子関係だ。
購買発注に限らず、受注・出荷・請求書など、SAPの帳票系データのほぼすべてがこの構造を持っている。
購買発注の場合、1枚の発注書（ヘッダ）に対して複数の発注品目（明細）が紐づく。さらに今回のAPI_PURCHASEORDER_2では、各明細の下に納入日程行（Schedule Line）という子レコードが存在する。
この3階層の構造をJSONで表現するのが、今回の実装における最大のポイントだ。
PurchaseOrder（ヘッダ）
└ _PurchaseOrderItem（明細）[]
└ _PurchaseOrderScheduleLineTP（納入日程行）[]
サンプルのExcelシートでは、1行目にヘッダ情報（A列〜G列）と明細の1行目（H列以降）をまとめて持ち、2行目以降に追加明細を記載する形を取っている。ヘッダは購買発注全体で1つなので、2行目の値を使い回す設計だ。
VBAコード全体の流れ──SAP OData V4 POST実装の解剖
それでは、実際に動作するVBAコード「CreatePurchaseOrder_FromExcel」の全体構造を解説しよう。コードは大きく8つのブロックに分かれている。
- 接続情報の取得（Configシート）
- ヘッダ項目の取得
- 明細の最終行取得
- OData APIのURL組み立て
- CSRFトークンの取得
- JSONボディの組み立て
- POSTの実行
- 購買発注番号の受け取り・書き戻し
この流れはSAP OData V4に対するPOST実装のテンプレートとして、購買発注以外の場面でも応用できる。
接続情報の取得──Configシートで安全に管理する
まず最初のブロックは、SAP接続に必要な情報の読み込みだ。
Set wsConfig = ThisWorkbook.Worksheets("Config")
baseUrl = Trim$(CStr(wsConfig.Range("B1").Value))
sapClient = Trim$(CStr(wsConfig.Range("B2").Value))
userId = Trim$(CStr(wsConfig.Range("B3").Value))
password = Trim$(CStr(wsConfig.Range("B4").Value))
接続情報（URL・クライアント番号・ユーザID・パスワード）を専用の「Config」シートに切り出しているのがポイントだ。これにより、接続先環境が変わっても（開発→テスト→本番など）、コードを修正することなくConfigシートの値を書き換えるだけで対応できる。
各項目が空の場合は即座にエラーを発生させ、処理を中断する。「空のまま実行してSAPに意図しないデータが入ってしまった」という事故を防ぐための防御的プログラミングだ。
本番運用では、パスワードをVBA内やExcelシート上に平文で持つことはセキュリティリスクになる。Windowsの資格情報マネージャーやVBAのInputBox経由での入力、あるいはSSO（シングルサインオン）の活用を検討してほしい。
CSRFトークン取得 ─ SAP OData POSTで必須の認証ステップ
POSTを実行する前に、必ずCSRFトークンを取得しなければならない。
これは SAP OData API におけるセキュリティ仕様であり、省略するとHTTP 403 Forbiddenが返ってくる。
http.Open "GET", serviceUrl & "/PurchaseOrder?sap-client=" & EncodeUrlComponent(sapClient) & "&$top=1", False, userId, password
http.setRequestHeader "Accept", "application/json"
http.setRequestHeader "X-CSRF-Token", "Fetch"
http.Send
csrfToken = Trim$(CStr(http.getResponseHeader("X-CSRF-Token")))
cookieHeader = ExtractCookieHeader(http.getAllResponseHeaders)
仕組みはシンプルだ。まずGETリクエストを送る際に、ヘッダに X-CSRF-Token: Fetch を付与する。するとSAPはレスポンスヘッダに実際のCSRFトークン値を乗せて返してくる。これを取り出してPOSTリクエストのヘッダ X-CSRF-Token: <取得した値> として付与する、という流れだ。
同時に、レスポンスの Set-Cookie ヘッダからCookie値も取り出し、POSTリクエストに引き継ぐ。セッション情報をPOSTにも渡すことで、SAPが同一セッションからのリクエストとして認識してくれる。
Cookie抽出には専用のプライベート関数 ExtractCookieHeader を使っている。全レスポンスヘッダを改行で分割し、set-cookie: で始まる行を探し出して、セミコロン前のキー＝値ペアだけを連結する処理だ。
CSRFトークンの取得に使うGETリクエストは $top=1 を付けてレコード数を1件に絞っている。
トークン取得が目的なので大量データを取得する必要はなく、レスポンスを最小化することで処理が高速化する。
JSONボディの組み立て ─ ヘッダ・明細・納入日程行の3階層
POSTリクエストの核心部分がJSONボディの組み立てだ。API_PURCHASEORDER_2では、以下の3階層構造をJSONで表現する必要がある。
以下は http.Send する直前のJson全文である。
{
"PurchaseOrderType": "NB",
"Supplier": "1000",
"PurchaseOrderDate": "2026-05-01",
"PurchasingOrganization": "A111",
"PurchasingGroup": "A11",
"CompanyCode": "A111",
"DocumentCurrency": "USD",
"_PurchaseOrderItem": [
{
"PurchaseOrderItem": "00010",
"Material": "RM1A111",
"PurchaseOrderItemText": "TEST1",
"OrderQuantity": 1,
"PurchaseOrderQuantityUnit": "PC",
"Plant": "A111",
"StorageLocation": "1000",
"_PurchaseOrderScheduleLineTP": [
{
"ScheduleLine": "0001",
"ScheduleLineDeliveryDate": "2026-09-25",
"ScheduleLineOrderQuantity": 1,
"PurchaseOrderQuantityUnit": "PC"
}
]
},
{
"PurchaseOrderItem": "00020",
"Material": "RM1A111",
"PurchaseOrderItemText": "TEST2",
"OrderQuantity": 2,
"PurchaseOrderQuantityUnit": "PC",
"Plant": "A111",
"StorageLocation": "1000",
"_PurchaseOrderScheduleLineTP": [
{
"ScheduleLine": "0002",
"ScheduleLineDeliveryDate": "2026-09-26",
"ScheduleLineOrderQuantity": 2,
"PurchaseOrderQuantityUnit": "PC"
}
]
}
]
}
VBAではJSON専用ライブラリを使わず、文字列連結でJSONを組み立てている。シンプルな構造の場合はこの方法で十分だ。コードの要所を見ていこう。
まずヘッダ部分を文字列として組み立てる。
jsonBody = "{"
jsonBody = jsonBody & """PurchaseOrderType"":""" & JsonEscape(docType) & ""","
jsonBody = jsonBody & """Supplier"":""" & JsonEscape(supplier) & ""","
...
jsonBody = jsonBody & """_PurchaseOrderItem"":["
続いてExcelの明細行をループしながら、明細配列の要素を追加していく。
For i = 4 To lastRow
If Trim$(CStr(ws.Cells(i, "H").Value)) <> "" Then
' 2件目以降はカンマを付ける
If Not isFirstItem Then
jsonBody = jsonBody & ","
End If
isFirstItem = False
' 明細JSONを追加
jsonBody = jsonBody & "{...}"
End If
Next i
このループ構造がVBAによるJSON配列生成の基本パターンだ。「最初の要素の前にはカンマを付けない、2番目以降は付ける」という制御を isFirstItem フラグで実現している。
各明細の最後には、納入日程行の配列 _PurchaseOrderScheduleLineTP を入れ子にする。今回は「1明細につき1納入日程行」の前提だが、複数納入日程が必要な場合は同様のループ構造を入れ子にすれば対応できる。
数値項目（OrderQuantity・ScheduleLineOrderQuantityなど）はJSONで文字列ではなく数値として渡す必要がある。VBAでは JsonNumber 関数を使って、Excelのカンマ区切り数値などを正規化した上で、ダブルクォートなしで出力している。
文字列で渡してしまうとSAP側でエラーになる場合があるので注意が必要だ。
POSTの実行と購買発注番号の受け取り
JSONボディが完成したら、いよいよPOSTリクエストを送信する。
http.Open "POST", postUrl, False, userId, password
http.setRequestHeader "Accept", "application/json"
http.setRequestHeader "Content-Type", "application/json"
http.setRequestHeader "X-CSRF-Token", csrfToken
If cookieHeader <> "" Then
http.setRequestHeader "Cookie", cookieHeader
End If
http.Send jsonBody
ヘッダには Content-Type: application/json、X-CSRF-Token: <取得した値>、そしてセッションCookieを付与する。これらが揃って初めて、SAPはリクエストを正規のものとして受け付ける。
POSTが成功した場合、SAPは作成した購買発注番号（PurchaseOrder）をレスポンスに含めて返してくる。コードでは3つの方法で購買発注番号の取得を試みている。
- レスポンスボディのJSONから
PurchaseOrderフィールドを抽出する - レスポンスヘッダの
LocationヘッダからURLを解析して抽出する - レスポンスヘッダの
OData-EntityIdヘッダから抽出する
SAPのバージョンや設定によって、どの方法で番号が返ってくるかが異なるため、3段階のフォールバックを実装しているのが実装上のポイントだ。
If statusCode = 201 Or statusCode = 200 Or statusCode = 204 Then
createdPo = ExtractJsonStringValue(responseText, "PurchaseOrder")
If createdPo = "" Then
locationHeader = http.getResponseHeader("Location")
createdPo = ExtractPurchaseOrderFromUrl(locationHeader)
End If
' 取得できた番号をExcelシートへ書き戻す
For i = 4 To lastRow
If Trim$(CStr(ws.Cells(i, "H").Value)) <> "" Then
ws.Cells(i, "S").Value = createdPo
End If
Next i
End If
購買発注番号が取得できたら、ExcelシートのS列（購買発注番号列）へ書き戻す。これにより、登録結果をそのままExcel上で確認できる。
SAP OData 購買発注登録でハマりやすいポイントと対処法
実際にAPI_PURCHASEORDER_2 のPOST実装を試みると、いくつかの壁にぶつかることがある。ここでは特にハマりやすいポイントを実体験を交えて紹介する。
JSON構造の落とし穴 ─ カンマとネストのミス
VBAで文字列としてJSONを組み立てる場合、最もよくあるミスがカンマの過不足だ。
JSONでは配列の最後の要素の後ろにカンマを付けてはいけない。しかしループで配列要素を動的に生成する場合、「最後かどうか」を判定するロジックが必要になる。今回のコードでは「最初の要素かどうか（isFirstItem）」を使ってカンマを先頭に付けるアプローチを採用している。これにより、最後の要素の後ろにカンマが付くことを防いでいる。
' 2件目以降の前にカンマを付ける（最後の後ろには付かない）
If Not isFirstItem Then
jsonBody = jsonBody & ","
End If
isFirstItem = False
もうひとつのよくあるミスが、入れ子構造の閉じ括弧の数だ。{・}・[・] の対応関係がひとつでもずれると、SAPはHTTP 400 Bad Requestを返す。
VBAのImmediateウィンドウ（Ctrl+G）に Debug.Print jsonBody でJSONを出力し、JSONLintなどのオンラインバリデータで構造チェックをする習慣をつけると良い。
また、JSONエスケープも見落としやすい。テキスト項目にダブルクォート（”）やバックスラッシュ（\）が含まれていると、JSONが壊れる。今回のコードでは JsonEscape 関数でこれらをエスケープしているが、独自実装する場合は忘れずに対処してほしい。
ステータスコード200・201・204の使い分け
POST成功時のHTTPステータスコードは、SAPのバージョンや設定によって異なる。
| ステータスコード | 意味 | レスポンスボディ |
|---|---|---|
| 201 Created | 新規リソース作成成功 | 作成されたリソースのJSON |
| 200 OK | 処理成功（一部のSAP実装） | 処理結果のJSON |
| 204 No Content | 処理成功・ボディなし | なし（Locationヘッダで番号取得） |
ODataの標準的なPOSTでは201が期待されることが多いが、SAPの実装によっては200や204が返ることもある。204の場合はレスポンスボディが空なので、JSONから購買発注番号を取得できない。このため、LocationヘッダやOData-EntityIdヘッダからURLを解析して番号を取り出すフォールバックが重要になる。
コード内の ExtractPurchaseOrderFromUrl 関数は、正規表現を使って PurchaseOrder('5000000087') のようなURLパターンから発注番号を抽出する。
re.Pattern = "PurchaseOrder\('([^']+)'\)"
Tips：実装時は必ずSAP開発環境で実際のステータスコードを確認しておくこと。Immediateウィンドウの Debug.Print http.Status と Debug.Print http.responseText が最大の手がかりになる。
日付フォーマットと数値の正規化
Excelの日付値とSAP ODataが要求するISOフォーマット（yyyy-mm-dd）は異なる。
Excelでは日付をシリアル値や地域設定によって異なる文字列形式で保持するため、そのまま渡すとSAP側でエラーになる。
今回のコードでは ToIsoDate 関数で日付を正規化している。
Private Function ToIsoDate(ByVal v As Variant) As String
If IsDate(v) Then
ToIsoDate = Format$(CDate(v), "yyyy-mm-dd")
Exit Function
End If
' 文字列の場合はセパレータを統一してからパース
Dim s As String
s = Replace$(Replace$(Trim$(CStr(v)), ".", "/"), "-", "/")
If IsDate(s) Then
ToIsoDate = Format$(CDate(s), "yyyy-mm-dd")
End If
End Function
同様に、Excelのカンマ区切り数値（例：1,000）をそのまま渡すとJSONが壊れる。NormalizeNumber 関数でカンマを除去し、JsonNumber 関数で数値として正しく出力している。
品目コードについては、SAP上では18桁左詰めゼロ埋めが必要なケースがある。今回のコードでは PadMaterial18 関数がその役割を担っているが、実際の環境に合わせてゼロ埋め処理を追加・調整することを推奨する。
エラーハンドリングの重要性
業務で使うツールである以上、エラーハンドリングは手を抜いてはいけない。今回のコードでは各ブロックに Err.Raise によるカスタムエラーを仕込み、最終的に ErrHandler でまとめてMsgBoxに表示する構造にしている。
エラーメッセージには「どの列のどの行が問題か」を明示することが重要だ。たとえば "J" & i & " 品目コードが空である。" というメッセージなら、ユーザはExcelのJ列のi行目を確認すればよいと即座にわかる。「登録に失敗した」だけでは原因がわからず、サポートコストが跳ね上がる。
Tips：デバッグ時はImmediateウィンドウへのDebug.Printを積極的に使おう。JSONボディの最終形、POSTのURLとステータス、レスポンスボディの全文を出力しておくと、問題の特定が格段に速くなる。
サンプルVBAコードの全文
本記事で紹介したVBAコードの全文を以下に貼り付けておく。このコードを内蔵したExcelサンプルファイルは 便利ツールと資料 にも保存してあるので、そちらも併せて活用いただきたい。
Excelサンプルファイルの場合は、「Main」シートにある「購買発注登録」ボタンを押下すればメインのプロシージャである CreatePurchaseOrder_FromExcel が実行される。
Option Explicit
Public Sub CreatePurchaseOrder_FromExcel()
Dim ws As Worksheet
Dim wsConfig As Worksheet
Dim baseUrl As String
Dim sapClient As String
Dim userId As String
Dim password As String
Dim serviceUrl As String
Dim postUrl As String
Dim docType As String
Dim supplier As String
Dim docDate As String
Dim purOrg As String
Dim purGroup As String
Dim companyCode As String
Dim currency1 As String
Dim itemNo As String
Dim material As String
Dim shortText As String
Dim qty As String
Dim unit As String
Dim plant As String
Dim storage As String
Dim schedLine As String
Dim delivDate As String
Dim schedQty As String
Dim csrfToken As String
Dim cookieHeader As String
Dim jsonBody As String
Dim http As Object
Dim statusCode As Long
Dim responseText As String
Dim createdPo As String
Dim locationHeader As String
Dim entityIdHeader As String
Dim lastRow As Long
Dim i As Long
Dim isFirstItem As Boolean
Dim itemCount As Long
On Error GoTo ErrHandler
Set ws = ThisWorkbook.Worksheets("Main")
Set wsConfig = ThisWorkbook.Worksheets("Config")
'========================================================
' 1. 接続情報を取得する
'========================================================
baseUrl = Trim$(CStr(wsConfig.Range("B1").Value))
sapClient = Trim$(CStr(wsConfig.Range("B2").Value))
userId = Trim$(CStr(wsConfig.Range("B3").Value))
password = Trim$(CStr(wsConfig.Range("B4").Value))
If baseUrl = "" Then Err.Raise vbObjectError + 100, , "Config!B1 の baseUrl が空である。"
If sapClient = "" Then Err.Raise vbObjectError + 101, , "Config!B2 の sap-client が空である。"
If userId = "" Then Err.Raise vbObjectError + 102, , "Config!B3 の userId が空である。"
If password = "" Then Err.Raise vbObjectError + 103, , "Config!B4 の password が空である。"
'========================================================
' 2. ヘッダ項目を取得する
' 複数明細でも購買発注ヘッダは1つなので、2行目を使う
'========================================================
docType = Trim$(CStr(ws.Range("A4").Value))
supplier = Trim$(CStr(ws.Range("B4").Value))
docDate = ToIsoDate(ws.Range("C4").Value)
purOrg = Trim$(CStr(ws.Range("D4").Value))
purGroup = Trim$(CStr(ws.Range("E4").Value))
companyCode = Trim$(CStr(ws.Range("F4").Value))
currency1 = Trim$(CStr(ws.Range("G4").Value))
If docType = "" Then Err.Raise vbObjectError + 110, , "A2 購買伝票タイプが空である。"
If supplier = "" Then Err.Raise vbObjectError + 111, , "B2 仕入先勘定コードが空である。"
If docDate = "" Then Err.Raise vbObjectError + 112, , "C2 購買伝票日付が不正である。"
If purOrg = "" Then Err.Raise vbObjectError + 113, , "D2 購買組織が空である。"
If purGroup = "" Then Err.Raise vbObjectError + 114, , "E2 購買グループが空である。"
If companyCode = "" Then Err.Raise vbObjectError + 115, , "F2 会社コードが空である。"
If currency1 = "" Then Err.Raise vbObjectError + 116, , "G2 通貨コードが空である。"
'========================================================
' 3. 明細の最終行を取得する
' H列「購買伝票の明細番号」を基準にする
'========================================================
lastRow = ws.Cells(ws.Rows.Count, "H").End(xlUp).Row
Debug.Print "===== lastRow ====="
Debug.Print lastRow
If lastRow < 4 Then
Err.Raise vbObjectError + 117, , "登録対象の明細行が存在しない。"
End If
'========================================================
' 4. OData V4 API URLを組み立てる
'========================================================
serviceUrl = baseUrl & "/sap/opu/odata4/iwbep/all/srvd_a2x/sap/api_purchaseorder_2/0001"
postUrl = serviceUrl & "/PurchaseOrder?sap-client=" & EncodeUrlComponent(sapClient)
'========================================================
' 5. CSRFトークンを取得する
'========================================================
Set http = CreateObject("MSXML2.XMLHTTP.6.0")
http.Open "GET", serviceUrl & "/PurchaseOrder?sap-client=" & EncodeUrlComponent(sapClient) & "&$top=1", False, userId, password
http.setRequestHeader "Accept", "application/json"
http.setRequestHeader "X-CSRF-Token", "Fetch"
http.Send
Debug.Print "===== CSRF Fetch Status ====="
Debug.Print http.Status & " " & http.statusText
Debug.Print "===== CSRF Fetch Response ====="
Debug.Print http.responseText
If http.Status <> 200 Then
Err.Raise vbObjectError + 130, , _
"CSRFトークン取得に失敗した。HTTP " & http.Status & " " & http.statusText & vbCrLf & http.responseText
End If
csrfToken = Trim$(CStr(http.getResponseHeader("X-CSRF-Token")))
cookieHeader = ExtractCookieHeader(http.getAllResponseHeaders)
Debug.Print "===== CSRF Token ====="
Debug.Print csrfToken
Debug.Print "===== Cookie Header ====="
Debug.Print cookieHeader
If csrfToken = "" Then
Err.Raise vbObjectError + 131, , "レスポンスヘッダに X-CSRF-Token が存在しない。"
End If
'========================================================
' 6. JSON本文を組み立てる
'
' JSON構造：
' PurchaseOrder
' └ _PurchaseOrderItem
' └ _PurchaseOrderScheduleLineTP
'========================================================
jsonBody = "{"
jsonBody = jsonBody & """PurchaseOrderType"":""" & JsonEscape(docType) & ""","
jsonBody = jsonBody & """Supplier"":""" & JsonEscape(supplier) & ""","
jsonBody = jsonBody & """PurchaseOrderDate"":""" & JsonEscape(docDate) & ""","
jsonBody = jsonBody & """PurchasingOrganization"":""" & JsonEscape(purOrg) & ""","
jsonBody = jsonBody & """PurchasingGroup"":""" & JsonEscape(purGroup) & ""","
jsonBody = jsonBody & """CompanyCode"":""" & JsonEscape(companyCode) & ""","
jsonBody = jsonBody & """DocumentCurrency"":""" & JsonEscape(currency1) & ""","
'========================================================
' 6-1. 発注明細配列の開始
'--------------------------------------------------------
' ここから _PurchaseOrderItem の配列を作る。
' Excelの2行目から最終行までをループし、
' H列に明細番号がある行を1明細としてJSONへ追加する。
'
' 例：
' "_PurchaseOrderItem": [
' { 明細10 },
' { 明細20 }
' ]
'========================================================
jsonBody = jsonBody & """_PurchaseOrderItem"":["
isFirstItem = True
itemCount = 0
'########################################################
'# 発注明細ループ開始
'#-------------------------------------------------------
'# i = 4 から lastRow まで、Excel上の明細行を順番に処理する。
'# H列が空の行は明細ではないと判断し、スキップする。
'########################################################
For i = 4 To lastRow
'----------------------------------------------------
' H列「購買伝票の明細番号」が空なら、この行は処理しない
'----------------------------------------------------
If Trim$(CStr(ws.Cells(i, "H").Value)) <> "" Then
'------------------------------------------------
' 6-2. 現在処理中のExcel行から明細項目を取得する
'------------------------------------------------
itemNo = FormatItemNumber(ws.Cells(i, "H").Value)
material = PadMaterial18(Trim$(CStr(ws.Cells(i, "J").Value)))
shortText = Trim$(CStr(ws.Cells(i, "K").Value))
qty = NormalizeNumber(ws.Cells(i, "L").Value)
unit = Trim$(CStr(ws.Cells(i, "M").Value))
plant = Trim$(CStr(ws.Cells(i, "N").Value))
storage = Trim$(CStr(ws.Cells(i, "O").Value))
schedLine = FormatScheduleLine(ws.Cells(i, "P").Value)
delivDate = ToIsoDate(ws.Cells(i, "Q").Value)
schedQty = NormalizeNumber(ws.Cells(i, "R").Value)
'------------------------------------------------
' 6-3. 現在処理中の明細行の必須チェック
'------------------------------------------------
If itemNo = "" Then Err.Raise vbObjectError + 200, , "H" & i & " 明細番号が不正である。"
If material = "" Then Err.Raise vbObjectError + 201, , "J" & i & " 品目コードが空である。"
If qty = "" Then Err.Raise vbObjectError + 202, , "L" & i & " 購買発注量が不正である。"
If unit = "" Then Err.Raise vbObjectError + 203, , "M" & i & " 数量単位が空である。"
If plant = "" Then Err.Raise vbObjectError + 204, , "N" & i & " プラントが空である。"
If storage = "" Then Err.Raise vbObjectError + 205, , "O" & i & " 保管場所が空である。"
If schedLine = "" Then Err.Raise vbObjectError + 206, , "P" & i & " 納入日程行番号が不正である。"
If delivDate = "" Then Err.Raise vbObjectError + 207, , "Q" & i & " 納入日付が不正である。"
If schedQty = "" Then Err.Raise vbObjectError + 208, , "R" & i & " 計画数量が不正である。"
Debug.Print "明細処理行 = " & i & _
", ItemNo = " & itemNo & _
", Material = " & material & _
", Qty = " & qty & _
", ScheduleLine = " & schedLine
'------------------------------------------------
' 6-4. JSON配列のカンマ制御
'------------------------------------------------
' JSON配列では、2件目以降の前にカンマが必要である。
'
' 1件目：
' { 明細10 }
'
' 2件目以降：
' ,{ 明細20 }
'------------------------------------------------
If Not isFirstItem Then
jsonBody = jsonBody & ","
End If
isFirstItem = False
itemCount = itemCount + 1
'------------------------------------------------
' 6-5. 1明細分のJSON開始
'------------------------------------------------
jsonBody = jsonBody & "{"
jsonBody = jsonBody & """PurchaseOrderItem"":""" & JsonEscape(itemNo) & ""","
jsonBody = jsonBody & """Material"":""" & JsonEscape(material) & ""","
jsonBody = jsonBody & """PurchaseOrderItemText"":""" & JsonEscape(shortText) & ""","
jsonBody = jsonBody & """OrderQuantity"":" & JsonNumber(qty) & ","
jsonBody = jsonBody & """PurchaseOrderQuantityUnit"":""" & JsonEscape(unit) & ""","
jsonBody = jsonBody & """Plant"":""" & JsonEscape(plant) & ""","
jsonBody = jsonBody & """StorageLocation"":""" & JsonEscape(storage) & ""","
'------------------------------------------------
' 6-6. 納入日程行JSON開始
'------------------------------------------------
' 今回は「1明細につき1納入日程行」の前提である。
'------------------------------------------------
jsonBody = jsonBody & """_PurchaseOrderScheduleLineTP"":[{"
jsonBody = jsonBody & """ScheduleLine"":""" & JsonEscape(schedLine) & ""","
jsonBody = jsonBody & """ScheduleLineDeliveryDate"":""" & JsonEscape(delivDate) & ""","
jsonBody = jsonBody & """ScheduleLineOrderQuantity"":" & JsonNumber(schedQty) & ","
jsonBody = jsonBody & """PurchaseOrderQuantityUnit"":""" & JsonEscape(unit) & """"
jsonBody = jsonBody & "}]"
'------------------------------------------------
' 6-7. 納入日程行JSON終了
'------------------------------------------------
jsonBody = jsonBody & "}"
'------------------------------------------------
' 6-8. 1明細分のJSON終了
'------------------------------------------------
End If
Next i
'########################################################
'# 発注明細ループ終了
'#-------------------------------------------------------
'# ここまでで、Excel上の全明細行が
'# _PurchaseOrderItem 配列へ追加されている。
'########################################################
If itemCount = 0 Then
Err.Raise vbObjectError + 209, , "登録対象の明細が存在しない。"
End If
'========================================================
' 6-9. 発注明細配列の終了
'========================================================
jsonBody = jsonBody & "]"
jsonBody = jsonBody & "}"
Debug.Print "===== itemCount ====="
Debug.Print itemCount
Debug.Print "===== POST URL ====="
Debug.Print postUrl
Debug.Print "===== JSON Body ====="
Debug.Print jsonBody
'========================================================
' 7. POST実行
'========================================================
Set http = CreateObject("MSXML2.XMLHTTP.6.0")
http.Open "POST", postUrl, False, userId, password
http.setRequestHeader "Accept", "application/json"
http.setRequestHeader "Content-Type", "application/json"
http.setRequestHeader "X-CSRF-Token", csrfToken
If cookieHeader <> "" Then
http.setRequestHeader "Cookie", cookieHeader
End If
http.Send jsonBody
statusCode = http.Status
responseText = http.responseText
Debug.Print "===== POST Status ====="
Debug.Print statusCode & " " & http.statusText
Debug.Print "===== POST Response ====="
Debug.Print responseText
'========================================================
' 8. 成功時に購買発注番号を取得する
'========================================================
If statusCode = 201 Or statusCode = 200 Or statusCode = 204 Then
createdPo = ""
If Trim$(responseText) <> "" Then
createdPo = ExtractJsonStringValue(responseText, "PurchaseOrder")
End If
If createdPo = "" Then
locationHeader = http.getResponseHeader("Location")
entityIdHeader = http.getResponseHeader("OData-EntityId")
Debug.Print "===== Location Header ====="
Debug.Print locationHeader
Debug.Print "===== OData-EntityId Header ====="
Debug.Print entityIdHeader
createdPo = ExtractPurchaseOrderFromUrl(locationHeader)
If createdPo = "" Then
createdPo = ExtractPurchaseOrderFromUrl(entityIdHeader)
End If
End If
If createdPo <> "" Then
For i = 4 To lastRow
If Trim$(CStr(ws.Cells(i, "H").Value)) <> "" Then
ws.Cells(i, "S").Value = createdPo
End If
Next i
MsgBox "購買発注の登録が完了した。" & vbCrLf & _
"購買伝票番号: " & createdPo & vbCrLf & _
"明細数: " & itemCount, _
vbInformation, "CreatePurchaseOrder_FromExcel"
Else
MsgBox "登録は成功したが、購買伝票番号を取得できなかった。" & vbCrLf & _
"イミディエイトウィンドウの Debug.Print を確認すること。", _
vbExclamation, "CreatePurchaseOrder_FromExcel"
End If
Else
MsgBox "登録に失敗した。" & vbCrLf & _
"HTTP " & statusCode & " " & http.statusText & vbCrLf & _
responseText, vbExclamation, "CreatePurchaseOrder_FromExcel"
End If
Exit Sub
ErrHandler:
Debug.Print "===== Error ====="
Debug.Print Err.Number & " / " & Err.Description
MsgBox Err.Description, vbExclamation, "CreatePurchaseOrder_FromExcel"
End Sub
Private Function ToIsoDate(ByVal v As Variant) As String
On Error GoTo EH
If IsDate(v) Then
ToIsoDate = Format$(CDate(v), "yyyy-mm-dd")
Exit Function
End If
Dim s As String
s = Trim$(CStr(v))
s = Replace$(s, ".", "/")
s = Replace$(s, "-", "/")
If IsDate(s) Then
ToIsoDate = Format$(CDate(s), "yyyy-mm-dd")
Exit Function
End If
EH:
ToIsoDate = ""
End Function
Private Function NormalizeNumber(ByVal v As Variant) As String
Dim s As String
s = Trim$(CStr(v))
If s = "" Then
NormalizeNumber = ""
Else
NormalizeNumber = Replace$(s, ",", "")
End If
End Function
Private Function FormatItemNumber(ByVal v As Variant) As String
Dim s As String
s = Trim$(CStr(v))
If s = "" Then
FormatItemNumber = ""
ElseIf IsNumeric(s) Then
FormatItemNumber = Right$("00000" & CStr(CLng(s)), 5)
Else
FormatItemNumber = s
End If
End Function
Private Function FormatScheduleLine(ByVal v As Variant) As String
Dim s As String
s = Trim$(CStr(v))
If s = "" Then
FormatScheduleLine = ""
ElseIf IsNumeric(s) Then
FormatScheduleLine = Right$("0000" & CStr(CLng(s)), 4)
Else
FormatScheduleLine = s
End If
End Function
Private Function PadMaterial18(ByVal s As String) As String
PadMaterial18 = Trim$(s)
End Function
Private Function JsonEscape(ByVal s As String) As String
s = Replace$(s, "\", "\\")
s = Replace$(s, """", "\""")
JsonEscape = s
End Function
Private Function JsonNumber(ByVal v As Variant) As String
Dim s As String
s = Trim$(CStr(v))
s = Replace$(s, ",", ".")
If s = "" Then
Err.Raise vbObjectError + 2000, , "数値項目が空である。"
End If
If Not IsNumeric(s) Then
Err.Raise vbObjectError + 2001, , "数値項目が不正である: " & s
End If
JsonNumber = s
End Function
Private Function EncodeUrlComponent(ByVal s As String) As String
EncodeUrlComponent = Replace$(s, " ", "%20")
End Function
Private Function ExtractCookieHeader(ByVal allHeaders As String) As String
Dim lines() As String
Dim i As Long
Dim line As String
Dim lowerLine As String
Dim rawCookie As String
Dim cookiePair As String
Dim posColon As Long
Dim posSemi As Long
Dim result As String
lines = Split(allHeaders, vbCrLf)
For i = LBound(lines) To UBound(lines)
line = lines(i)
lowerLine = LCase$(line)
If Left$(lowerLine, 11) = "set-cookie:" Then
posColon = InStr(1, line, ":", vbTextCompare)
If posColon > 0 Then
rawCookie = Trim$(Mid$(line, posColon + 1))
posSemi = InStr(1, rawCookie, ";")
If posSemi > 0 Then
cookiePair = Left$(rawCookie, posSemi - 1)
Else
cookiePair = rawCookie
End If
If result <> "" Then
result = result & "; "
End If
result = result & cookiePair
End If
End If
Next i
ExtractCookieHeader = result
End Function
Private Function ExtractJsonStringValue(ByVal jsonText As String, ByVal keyName As String) As String
Dim re As Object
Dim matches As Object
Set re = CreateObject("VBScript.RegExp")
re.Global = False
re.IgnoreCase = False
re.Pattern = """" & keyName & """" & "\s*:\s*""([^""]*)"""
If re.Test(jsonText) Then
Set matches = re.Execute(jsonText)
ExtractJsonStringValue = matches(0).SubMatches(0)
Else
ExtractJsonStringValue = ""
End If
End Function
Private Function ExtractPurchaseOrderFromUrl(ByVal s As String) As String
Dim re As Object
Dim matches As Object
Set re = CreateObject("VBScript.RegExp")
re.Global = False
re.IgnoreCase = False
re.Pattern = "PurchaseOrder\('([^']+)'\)"
If re.Test(s) Then
Set matches = re.Execute(s)
ExtractPurchaseOrderFromUrl = matches(0).SubMatches(0)
Else
ExtractPurchaseOrderFromUrl = ""
End If
End Function
まとめ：Excel VBA と SAP OData の連携で業務自動化の基礎を学ぶ
本記事では、SAP OData V4 API「API_PURCHASEORDER_2」とExcel VBAを使った購買発注の登録（POST）実装について、実際に動作するコードを交えながら徹底解説した。
改めて要点を整理しよう。
- POSTとGETの違い：POSTではCSRFトークンの取得とJSONボディの組み立てが追加で必要になる。
- 3階層のJSON構造：API_PURCHASEORDER_2はヘッダ→明細→納入日程行という入れ子構造で登録する。SAPの帳票データに共通するパターンだ。
- CSRFトークン：GETリクエストで事前取得し、POSTヘッダに付与する。Cookieも引き継ぐことでセッションを維持する。
- ステータスコードのフォールバック：200・201・204いずれも成功扱いとし、購買発注番号はJSON・Location・OData-EntityIdの3段階で取得を試みる。
- 日付・数値の正規化：ExcelとSAP ODataの形式差異を吸収するユーティリティ関数を用意する。
GETとPOSTの両方を使いこなせるようになれば、SAP ODataを使った業務自動化の幅は一気に広がる。
Excelに入力したデータをワンクリックでSAPに登録する仕組みは、入力ミスの削減・作業時間の短縮・データ品質の向上に直結する。
本記事で紹介したVBAコードは、購買発注以外のSAP OData APIに対するPOST実装のテンプレートとしても活用できる。CSRFトークンの取得ロジック、JSON組み立てパターン、エラーハンドリング構造はそのまま流用可能だ。ぜひ自分のプロジェクトにカスタマイズして使ってほしい。
次のステップとしては、今回のPOSTをベースに、既存POの更新（PATCH）や削除（DELETE）への応用、あるいはOData V4のバッチリクエストを使った複数伝票の一括登録にも挑戦してみてほしい。SAP ODataとExcel VBA SAP連携の世界は、探れば探るほど奥が深い。
コメント