S/4HANA拡張 - 得意先の与信限度額一括更新 (クリーンコア、標準ODataサービス利用)
Excel からも ODataサービスを利用することができます。
照会処理(GET)は ODataフィードなどを利用してノンコーディングで簡単に実装できます。
更新処理(POST/PUT/PATCH/DEL)を実装するには どのようにコードを書けばよいのか、この記事では具体的な手順やポイントを解説します。
S/4HANA の ODataサービスを使ってデータを更新したい、Fioriアプリや RAPアプリを作成するのは敷居が高い、クリーンコアでないと困る、VBA ならコードを読んだことがある、という方も多いかと思います。
公開インターフェースの ODataサービスを利用して、クリーンコアを維持しながら業務に役立つアプリケーション・ツールを Excel で作成してみましょう。
タイトルの通り S/4HANA の得意先 与信限度額を一括で更新するためのツールを Excel で作成します。
BPマスタ更新画面はバッチインプットを利用することができないため、大量のデータ更新作業を効率化・自動化するために S/4HANA公開インターフェースの ODataサービスを利用します。
Excel の設定、VBA開発の手順、ODataサービスの呼び出し方法、注意点など、この記事を参考にしてみてください。
S/4HANA の得意先 与信限度額を更新する
今回 更新する与信限度額情報は BPマスタ画面の以下の赤枠項目です。
BPマスタ更新画面(Tr-cd: BP)
BP Role "SAP Credit Management"
"Credit Segment" を入力
"Credit Limit and Control"タブ
Limit :与信限度額
Valid To : 有効終了日
クリーンコアを維持する方法
BPマスタ更新画面(Tr-cd: BP)はバッチインプットが利用できないため、更新を行うためには SAP標準の ODataサービスを利用します。
ビジネスパートナーの与信関連情報を更新する ODataサービスは
"Business Partner" ではなく、
"Credit Management Master Data Integration" になります。
このサービスを使用すると、ビジネス パートナーの SAP Credit Management に関連するデータを更新できます。たとえば、新しいビジネス パートナーを作成した後、ビジネス パートナーのロール SAP Credit Management を作成し、関連データを更新できます。ビジネス パートナー ロール SAP Credit Management で、リスク クラス、制限ルール、チェック ルールなど、ビジネス パートナーの与信管理に関連するデータの読み取り、作成、更新を行うことができます。また、与信限度、ブロック理由などの与信セグメント データの読み取り、作成、更新、削除を行うこともできます。
標準ODataサービスの利用方法
与信限度情報の更新は以下の ODataサービスで行います。
API_CRDTMBUSINESSPARTNER/CreditManagementAccount(BusinessPartner='{BusinessPartner}',CreditSegment='{CreditSegment}’)
メソッド: PATCH (エンティティの更新は POST ではなく PATCH を使用)
S/4HANA ODataサービス利用時の共通説明
Request Header には下記を設定します。
Query Parameter に SAP接続先のクライアント番号を設定します。
認証方式
VBA 開発で実現する手順
更新用(申請)データを Excel で作成します。
更新マクロで更新用データを読み、S/4HANA の ODataサービスを呼び出し与信限度情報を更新します。更新結果(成功 or エラー)は申請データに記録します。
更新用(申請)データExcel の準備
S/4HANA に以下のレポートが用意されています。
Tr-cd: UKM_MASS_DSP2
レポートの出力項目の中から必要な項目を選択し(不要な項目は非表示にする)、ユーザ定義のレイアウトを作成します。レイアウトを登録しておくと次回から指定したレイアウトで実行結果を表示できます。
レポートの出力結果をスプレッドシートに Export します。
Exportデータを利用して更新用のデータを作成します。(H〜J列)
現在の設定金額から 10%削減、有効期間を6ヶ月延長します。
更新対象のレコードに "Y" を指定します。
下図では Excelマクロから更新用データファイルの内容を読み込み、ODataサービスを使用して与信限度情報を更新しています。
オープンな REST API 方式で通信を行うため、利用者側の PC には Excel 以外のアプリは不要です。(SAPGUI など不要)
ここからは更新マクロの Excel ファイルを開発していきます。
新規Excelブックを作成します。ファイルの拡張子は .xlsm (Excelマクロ有効ブック)を指定します。
Excel の VBA にライブラリ追加
VBA を起動し、[ツール]→[参照設定]から参照可能なライブラリファイルを追加します。
・Microsoft Scripting Runtime : Dictionary を利用する際に必要
・Microsoft XML v6.0 : MSXML2.XMLHTTP で OData を利用するため必要
設定情報を定義
マクロ内で参照する各種の設定情報を定義します。
シート名: setting
以下のレイアウトで入力項目群とボタンを配置します。
OData接続情報(host、port、クライアント、ユーザID、パスワード)はご自身の利用環境に合わせて定義してください。
入力項目(10個)のセルに以下の名前を付けます。
VBA-JSONのインポート
VBA で JSON の利用を容易にするツール "VBA-JSON" をインポートします。
GitHub からソースコードをダウンロードします。
"VBA-JSON" は Tim Hall氏が開発した JSON のパースに特化した VBAライブラリです。(MITライセンス)
"specs" フォルダを選択します。
"specs" フォルダ内の "JsonConverter.bas" (ソースコード)を選択してダウンロードします。
ダウンロードした "JsonConverter.bas"ファイルを VBA のプロジェクトにドラッグ&ドロップしてインポートします。
以下の状態になればインポート完了です。
マクロ登録
ボタンを右クリックし、マクロを登録します。
ボタンをクリックした時に "Check_OData_Access" サブルーチンが実行されるよう紐付けします。
サブルーチン内に以下のコードを記述します。
Sub Check_OData_Access()
Dim httpReq As New XMLHTTP60
Dim strURL As String
Dim jsonObj As Object
Worksheets("setting").Activate
strURL = ThisWorkbook.Sheets("setting").Range("applicationServer") & _
ThisWorkbook.Sheets("setting").Range("odataServiceFetch") & _
"?sap-client=" & ThisWorkbook.Sheets("setting").Range("sapClient")
Set httpReq = CreateObject("MSXML2.XMLHTTP")
httpReq.Open "GET", strURL, False
' ID と Password を Base64 へエンコードする
sId = ThisWorkbook.Sheets("setting").Range("sapUserId")
sPass = ThisWorkbook.Sheets("setting").Range("sapPassword")
sIdPass = Call_EncodeBase64(sId & ":" & sPass)
' ヘッダー作成
httpReq.setRequestHeader "Authorization", "Basic " & sIdPass
httpReq.setRequestHeader "Content-Type", "application/json; charset=UTF-8"
httpReq.setRequestHeader "Accept", "application/json"
' ODataサービス呼び出し
httpReq.send
' 結果確認
'Debug.Print "httpReq.Status:"; httpReq.Status
'Debug.Print "httpReq.responseText"; httpReq.responseText
Worksheets("setting").Cells(12, 5).Clear
Worksheets("setting").Cells(12, 6).Clear
' 取得結果をシートに記載
If httpReq.Status = 200 Then
'Debug.Print "成功"
Worksheets("setting").Cells(12, 5).Value = "SUCCESS"
Worksheets("setting").Cells(12, 5).Interior.ColorIndex = 8
Worksheets("setting").Cells(12, 6).Value = ""
Else
'Debug.Print "エラー: " & httpReq.Status & " - " & httpReq.statusText
Worksheets("setting").Cells(12, 5).Value = "ERROR"
Worksheets("setting").Cells(12, 5).Interior.ColorIndex = 3
' パース
Set jsonObj = JsonConverter.ParseJson(httpReq.responseText)
Worksheets("setting").Cells(12, 6).Value = jsonObj("error")("message")("value")
End If
End Sub"Check_OData_Access" サブルーチンに続けて "Call_EncodeBase64" 関数を記述します。
Public Function Call_EncodeBase64(ByRef text As String) As String
'参照設定不要、オブジェクト準備
Dim node As Object, obj As Object
Set node = CreateObject("Msxml2.DOMDocument.3.0").createElement("base64")
Set obj = CreateObject("ADODB.Stream")
'エンコード(textをBASE64へ変換)
node.DataType = "bin.base64"
With obj
.Type = 2
.Charset = "us-ascii"
.Open
.WriteText text
.Position = 0
.Type = 1
.Position = 0
End With
node.nodeTypedValue = obj.Read
'改行を削除して返却(上記で取り除けない為)
Call_EncodeBase64 = Replace(node.text, vbLf, "")
End FunctionODataサービス呼び出しをテスト
VBA ソースコードを保存し、"ODataサービス呼び出しをテストする" のボタンをクリックし、マクロを実行します。
ODataサービス呼び出しが成功した場合、"SUCCESS" メッセージが表示されます。
ODataサービス呼び出しが失敗した場合、"ERROR" メッセージが表示されます。エラー原因を調査し対応してください。
・ODataサービスがカタログ公開されているか
・OData接続情報の値が間違っていないか
与信限度額更新用シートの作成
更新マクロの Excelファイルに新しいシートを作成します。
シート名: vbaSheet
以下のレイアウトで各セルのタイトルとボタンを配置します。
セル範囲"A9:M1008" に以下の名前を付けます。
"dataArea" には、申請データファイルの "data"シートの内容をマクロの中で "vbaSheet"シートへコピーする予定です。
別Excelファイルを読み、内容をコピーする処理を実装するには少し手間がかかるため、この部分の処理実装は後回しにします。
まずはマニュアルで申請データファイルの "data"シートのデータ部分を更新マクロの "vbaSheet" にコピー&ペーストしておいてください。
マクロ登録
ボタンを右クリックし、マクロを登録します。
ボタンをクリックした時に "CreditLimit_Maint" サブルーチンが実行されるよう紐付けします。
サブルーチン内に以下のコードを記述します。
Sub CreditLimit_Maint()
' Dim filePath As Variant
' Dim fileName As String
Dim vbaSheetName As String
Dim sheet As Worksheet
' Dim xErr As Boolean
Dim cntRecord As Integer
Dim cntSuccess As Integer
Dim cntError As Integer
Dim startTime As String
Dim endTime As String
' filePath = Application.GetOpenFilename("Excelブック,*.xls?")
'
' If filePath <> False Then
' fileName = Dir(filePath)
'
' ' 処理中
' Application.ScreenUpdating = False
' Application.Cursor = xlWait
' Else
' MsgBox "実行がキャンセルされました"
' Exit Sub
' End If
vbaSheetName = ThisWorkbook.Sheets("setting").Range("vbaSheetName") ' VBA Sheet名
Set sheet = ThisWorkbook.Sheets(vbaSheetName)
' 更新結果サマリ領域をクリア
sheet.Cells(2, 12).Clear
sheet.Cells(3, 12).Clear
sheet.Cells(4, 12).Clear
sheet.Cells(5, 12).Clear
sheet.Cells(6, 12).Clear
' 更新処理 開始
cntRecord = 0
cntSuccess = 0
cntError = 0
startTime = Format(Now, "yyyy/mm/dd hh:mm:ss")
endTime = ""
' ' データ読み込み
' Call Data_Read(filePath, fileName, sheet, xErr)
'
' If xErr Then
' ' 更新結果サマリ
' endTime = Format(Now, "yyyy/mm/dd hh:mm:ss")
' Call Record_UpdateSummary(sheet, cntRecord, cntSuccess, cntError, startTime, endTime)
' Exit Sub
' End If
' OData登録
Call OData_PATCH(sheet, cntRecord, cntSuccess, cntError)
' 更新結果サマリ
endTime = Format(Now, "yyyy/mm/dd hh:mm:ss")
Call Record_UpdateSummary(sheet, cntRecord, cntSuccess, cntError, startTime, endTime)
' ' 実行結果を書き込み
' Call PATCH_Result_Write(filePath, sheet)
'
' ' 解除
' Application.ScreenUpdating = True
' Application.Cursor = xlDefault
MsgBox "処理を終了しました"
End Sub
Sub OData_PATCH(ByVal sheet As Worksheet, cntRecord As Integer, cntSuccess As Integer, cntError As Integer)
Dim vbaSheetName As String
Dim vbaStartRow As Integer
Dim httpReq As New XMLHTTP60
Dim strURL As String
Dim token As String
Dim payload As String
Dim businessPartner As String
Dim creditSegment2 As String
Dim updateFlg As String
Dim jsonObj As Object
vbaSheetName = ThisWorkbook.Sheets("setting").Range("vbaSheetName") ' VBA Sheet名
vbaStartRow = ThisWorkbook.Sheets("setting").Range("vbaStartRow") ' VBA データ開始行
Worksheets(vbaSheetName).Activate
strURL = ThisWorkbook.Sheets("setting").Range("applicationServer") & _
ThisWorkbook.Sheets("setting").Range("odataServiceFetch") & _
"?sap-client=" & ThisWorkbook.Sheets("setting").Range("sapClient")
Set httpReq = CreateObject("MSXML2.XMLHTTP")
httpReq.Open "GET", strURL, False
' ID と Password を Base64 へエンコードする
sId = ThisWorkbook.Sheets("setting").Range("sapUserId")
sPass = ThisWorkbook.Sheets("setting").Range("sapPassword")
sIdPass = Call_EncodeBase64(sId & ":" & sPass)
' ヘッダー作成
httpReq.setRequestHeader "Authorization", "Basic " & sIdPass
httpReq.setRequestHeader "Content-Type", "application/json; charset=UTF-8"
httpReq.setRequestHeader "Accept", "application/json"
httpReq.setRequestHeader "X-CSRF-Token", "Fetch"
' X-CSRF-Token の取得
httpReq.send
' 結果確認
'Debug.Print httpReq.responseText
' トークンを取得
token = httpReq.getResponseHeader("X-CSRF-Token")
Dim i As Long
For i = 0 To 999 Step 1
businessPartner = sheet.Cells(vbaStartRow + i, 1).Value
creditSegment2 = sheet.Cells(vbaStartRow + i, 3).Value
updateFlg = sheet.Cells(vbaStartRow + i, 10).Value
If businessPartner = "" Then
Exit For
End If
' Update flag
If updateFlg = "Y" Or _
updateFlg = "y" Or _
updateFlg = "YES" Or _
updateFlg = "yes" Or _
updateFlg = "Yes" Then
Else
GoTo NextIteration ' 処理を飛ばす。次のループへスキップ
End If
Worksheets(vbaSheetName).Range("K:M").NumberFormatLocal = "@" '文字列指定
Worksheets(vbaSheetName).Cells(vbaStartRow + i, 11).Value = Format(Now, "yyyy/mm/dd hh:mm:ss")
' New Limit Valid To が空
If sheet.Cells(vbaStartRow + i, 9).Value = "" Or _
sheet.Cells(vbaStartRow + i, 9).Value = "0:00:00" Then
Worksheets(vbaSheetName).Cells(vbaStartRow + i, 12).Value = "ERROR"
Worksheets(vbaSheetName).Cells(vbaStartRow + i, 12).Interior.ColorIndex = 3
Worksheets(vbaSheetName).Cells(vbaStartRow + i, 13).Value = "New Limit_Valid_To is invalid"
GoTo NextIteration ' 処理を飛ばす。次のループへスキップ
End If
cntRecord = cntRecord + 1
' Patch するデータを JSON に編集
payload = CreateJsonPayload(sheet, vbaStartRow, i)
strURL = ThisWorkbook.Sheets("setting").Range("applicationServer") & _
ThisWorkbook.Sheets("setting").Range("odataService") & _
"(BusinessPartner='" & businessPartner & "',CreditSegment='" & creditSegment2 & "')" & _
"?sap-client=" & ThisWorkbook.Sheets("setting").Range("sapClient")
Set httpReq = CreateObject("MSXML2.XMLHTTP")
httpReq.Open "PATCH", strURL, False
' ヘッダー作成
httpReq.setRequestHeader "Authorization", "Basic " & sIdPass
httpReq.setRequestHeader "Content-Type", "application/json; charset=UTF-8"
httpReq.setRequestHeader "Accept", "application/json"
httpReq.setRequestHeader "X-CSRF-Token", token ' トークン
' PATCHリクエスト送信
httpReq.send payload
' 結果確認
'Debug.Print httpReq.responseText
' 取得結果をシートに記載
If httpReq.Status = 204 Then
'Debug.Print "更新成功"
'Worksheets("vbaSheet").Cells(i + 18, 10).Value = httpReq.Status
Worksheets(vbaSheetName).Cells(vbaStartRow + i, 12).Value = "SUCCESS"
Worksheets(vbaSheetName).Cells(vbaStartRow + i, 12).Interior.ColorIndex = 8
Worksheets(vbaSheetName).Cells(vbaStartRow + i, 13).Value = ""
cntSuccess = cntSuccess + 1
Else
'Debug.Print "エラー: " & httpReq.Status & " - " & httpReq.statusText
Worksheets(vbaSheetName).Cells(vbaStartRow + i, 12).Value = "ERROR"
Worksheets(vbaSheetName).Cells(vbaStartRow + i, 12).Interior.ColorIndex = 3
' パース
Set jsonObj = JsonConverter.ParseJson(httpReq.responseText)
Worksheets(vbaSheetName).Cells(vbaStartRow + i, 13).Value = jsonObj("error")("message")("value")
cntError = cntError + 1
End If
NextIteration:
Next i
End Sub
Function CreateJsonPayload(ByVal sheet As Worksheet, ByVal vbaStartRow As Integer, ByVal i As Long) As String
Dim formatDate As String
' JSON のルートオブジェクトを作成
Dim json As Object
Set json = CreateObject("Scripting.Dictionary") ' 空の JSONオブジェクトを作成
'--------
' 第1階層
'--------
json.Add "CreditLimitAmount", sheet.Cells(vbaStartRow + i, 8).Value
formatDate = Format(sheet.Cells(vbaStartRow + i, 9).Value, "yyyy-mm-dd") & "T00:00:00"
json.Add "CreditLimitValidityEndDate", formatDate
json.Add "CreditSegmentCurrency", sheet.Cells(vbaStartRow + i, 5).Value
' JSON を文字列に変換
Dim payload As String
payload = JsonConverter.ConvertToJson(json)
' 返り値
CreateJsonPayload = payload
End Function
Sub Record_UpdateSummary(ByVal sheet As Worksheet, ByVal cntRecord As Integer, ByVal cntSuccess As Integer, ByVal cntError As Integer, ByVal startTime As String, ByVal endTime As String)
sheet.Cells(2, 12).Value = startTime
sheet.Cells(3, 12).Value = endTime
sheet.Cells(4, 12).Value = cntRecord
sheet.Cells(5, 12).Value = cntSuccess
sheet.Cells(6, 12).Value = cntError
End Subソースコード解説
行の先頭がシングルクォーテーション(コメントアウト)の箇所は、別Excelファイルから内容をコピーする処理に必要になるコードです。
コピー処理は最初は実装しないため、コメントアウトの状態にしておきます。
メインの CreditLimit_Maint を見ていきます。
理解しやすいように、変数定義のコードと、コメントアウト行を割愛して、ソースを眺めてみます。
Sub CreditLimit_Maint()
(削除)
vbaSheetName = ThisWorkbook.Sheets("setting").Range("vbaSheetName") ' VBA Sheet名
Set sheet = ThisWorkbook.Sheets(vbaSheetName)
' 更新結果サマリ領域をクリア
sheet.Cells(2, 12).Clear
sheet.Cells(3, 12).Clear
sheet.Cells(4, 12).Clear
sheet.Cells(5, 12).Clear
sheet.Cells(6, 12).Clear
' 更新処理 開始
cntRecord = 0
cntSuccess = 0
cntError = 0
startTime = Format(Now, "yyyy/mm/dd hh:mm:ss")
endTime = ""
(削除)
' OData登録
Call OData_PATCH(sheet, cntRecord, cntSuccess, cntError)
' 更新結果サマリ
endTime = Format(Now, "yyyy/mm/dd hh:mm:ss")
Call Record_UpdateSummary(sheet, cntRecord, cntSuccess, cntError, startTime, endTime)
(削除)
MsgBox "処理を終了しました"
End Sub前半のコードは件数カウントをクリアしています。
OData登録の処理は Call ステートメントで OData_PATCH 側で行っています。
最後は Call ステートメントで Record_UpdateSummary 側で処理件数を表示しています。
メインとなる OData_PATCH の中を見ていきます。
vbaSheetName = ThisWorkbook.Sheets("setting").Range("vbaSheetName") ' VBA Sheet名
vbaStartRow = ThisWorkbook.Sheets("setting").Range("vbaStartRow") ' VBA データ開始行
Worksheets(vbaSheetName).Activate
strURL = ThisWorkbook.Sheets("setting").Range("applicationServer") & _
ThisWorkbook.Sheets("setting").Range("odataServiceFetch") & _
"?sap-client=" & ThisWorkbook.Sheets("setting").Range("sapClient")
Set httpReq = CreateObject("MSXML2.XMLHTTP")
httpReq.Open "GET", strURL, False
' ID と Password を Base64 へエンコードする
sId = ThisWorkbook.Sheets("setting").Range("sapUserId")
sPass = ThisWorkbook.Sheets("setting").Range("sapPassword")
sIdPass = Call_EncodeBase64(sId & ":" & sPass)
' ヘッダー作成
httpReq.setRequestHeader "Authorization", "Basic " & sIdPass
httpReq.setRequestHeader "Content-Type", "application/json; charset=UTF-8"
httpReq.setRequestHeader "Accept", "application/json"
httpReq.setRequestHeader "X-CSRF-Token", "Fetch"
' X-CSRF-Token の取得
httpReq.send
' 結果確認
'Debug.Print httpReq.responseText
' トークンを取得
token = httpReq.getResponseHeader("X-CSRF-Token")vbaSheetName = ThisWorkbook.Sheets("setting").Range("vbaSheetName") vbaStartRow = ThisWorkbook.Sheets("setting").Range("vbaStartRow")
setting シートの セル名 "vbaSheetName" と "vbaStartRow" のセルの値を取得します。実行結果は
vbaSheetName = "vbaSheet"
vbaStartRow = 9
になります。
strURL = ThisWorkbook.Sheets("setting").Range("applicationServer") & _
ThisWorkbook.Sheets("setting").Range("odataServiceFetch") & _
"?sap-client=" & ThisWorkbook.Sheets("setting").Range("sapClient")
上記を実行すると以下の値になります。
sId = ThisWorkbook.Sheets("setting").Range("sapUserId")
sPass = ThisWorkbook.Sheets("setting").Range("sapPassword")
sIdPass = Call_EncodeBase64(sId & ":" & sPass)
S/4HANAに接続する際の認証方式は Basic認証を利用します。
SAPユーザID と ログインパスワード を Base64 にエンコードしています。
httpReq.setRequestHeader "Authorization", "Basic " & sIdPass httpReq.setRequestHeader "Content-Type", "application/json; charset=UTF-8"
httpReq.setRequestHeader "Accept", "application/json" httpReq.setRequestHeader "X-CSRF-Token", "Fetch"
「S/4HANA ODataサービス利用時の共通説明」で説明した Request Header を設定しています。
CSRF トークンの取得
ODataサービスを利用する際の HTTPメソッドには
があります。POST などの更新を行うリクエストは SAP NetWeaver Gateway によって CSRF(クロスサイトリクエストフォージェリ)アタックから保護されます。通常、そのためには、クライアントが変更リクエストとともに CSRF トークンを提供する必要があり、クライアントは HTTPヘッダ "X-CSRF-Token" を値"Fetch" に設定して、サービスの最初の非更新呼び出し(下図1) でこのトークンを取得します。 CSRF トークンはサーバから同じレスポンスヘッダで返されます(3)。クライアントはヘッダ "X-CSRF-Token" を使用して、このトークンを変更リクエスト(4) に使用します。
' X-CSRF-Token の取得
httpReq.send
' トークンを取得
token = httpReq.getResponseHeader("X-CSRF-Token")
GET メソッドのリクエストを送信(1)します。
S/4HANA からレスポンスを取得し、レスポンスヘッダから CSRFトークンを取得して(3)、変数 token に保存します。
Dim i As Long
For i = 0 To 999 Step 1
businessPartner = sheet.Cells(vbaStartRow + i, 1).Value
creditSegment2 = sheet.Cells(vbaStartRow + i, 3).Value
updateFlg = sheet.Cells(vbaStartRow + i, 10).Value
If businessPartner = "" Then
Exit For
End If
' Update flag
If updateFlg = "Y" Or _
updateFlg = "y" Or _
updateFlg = "YES" Or _
updateFlg = "yes" Or _
updateFlg = "Yes" Then
Else
GoTo NextIteration ' 処理を飛ばす。次のループへスキップ
End If
Worksheets(vbaSheetName).Range("K:M").NumberFormatLocal = "@" '文字列指定
Worksheets(vbaSheetName).Cells(vbaStartRow + i, 11).Value = Format(Now, "yyyy/mm/dd hh:mm:ss")
' New Limit Valid To が空
If sheet.Cells(vbaStartRow + i, 9).Value = "" Or _
sheet.Cells(vbaStartRow + i, 9).Value = "0:00:00" Then
Worksheets(vbaSheetName).Cells(vbaStartRow + i, 12).Value = "ERROR"
Worksheets(vbaSheetName).Cells(vbaStartRow + i, 12).Interior.ColorIndex = 3
Worksheets(vbaSheetName).Cells(vbaStartRow + i, 13).Value = "New Limit_Valid_To is invalid"
GoTo NextIteration ' 処理を飛ばす。次のループへスキップ
End If
cntRecord = cntRecord + 1
' Patch するデータを JSON に編集
payload = CreateJsonPayload(sheet, vbaStartRow, i)
strURL = ThisWorkbook.Sheets("setting").Range("applicationServer") & _
ThisWorkbook.Sheets("setting").Range("odataService") & _
"(BusinessPartner='" & businessPartner & "',CreditSegment='" & creditSegment2 & "')" & _
"?sap-client=" & ThisWorkbook.Sheets("setting").Range("sapClient")
Set httpReq = CreateObject("MSXML2.XMLHTTP")
httpReq.Open "PATCH", strURL, False
' ヘッダー作成
httpReq.setRequestHeader "Authorization", "Basic " & sIdPass
httpReq.setRequestHeader "Content-Type", "application/json; charset=UTF-8"
httpReq.setRequestHeader "Accept", "application/json"
httpReq.setRequestHeader "X-CSRF-Token", token ' トークン
' PATCHリクエスト送信
httpReq.send payload
' 結果確認
'Debug.Print httpReq.responseText
' 取得結果をシートに記載
If httpReq.Status = 204 Then
'Debug.Print "更新成功"
'Worksheets("vbaSheet").Cells(i + 18, 10).Value = httpReq.Status
Worksheets(vbaSheetName).Cells(vbaStartRow + i, 12).Value = "SUCCESS"
Worksheets(vbaSheetName).Cells(vbaStartRow + i, 12).Interior.ColorIndex = 8
Worksheets(vbaSheetName).Cells(vbaStartRow + i, 13).Value = ""
cntSuccess = cntSuccess + 1
Else
'Debug.Print "エラー: " & httpReq.Status & " - " & httpReq.statusText
Worksheets(vbaSheetName).Cells(vbaStartRow + i, 12).Value = "ERROR"
Worksheets(vbaSheetName).Cells(vbaStartRow + i, 12).Interior.ColorIndex = 3
' パース
Set jsonObj = JsonConverter.ParseJson(httpReq.responseText)
Worksheets(vbaSheetName).Cells(vbaStartRow + i, 13).Value = jsonObj("error")("message")("value")
cntError = cntError + 1
End If
NextIteration:
Next iFor…Next ステートメントで "vbaSheet" にコピーした申請データ分、繰り返し処理を行います。上記コードでは最大 1,000行のデータを処理するようにしました。
・1,000行を超えるデータは処理されません
・申請データ行の中で Business Partner セルにブランクが見つかった場合、以降の行は処理しません (ループ終了)
・J列 "Update?(Y)" セル値が "Y(es)"の行のみ処理を行います
ODataサービスの項目マッピング
PATCH リクエストを送信する際、更新するデータを OData サービスに引き渡します。引き渡すデータの構造は以下の形式です。
背景色がグレーのエンティティ(項目)は今回は使用しない項目のため、マッピングする必要はありません。
・New Credit Limit
・New Limit Valid To
・Currency
の 3項目をマッピングすれば OK です。
payload = CreateJsonPayload(sheet, vbaStartRow, i)
上記のマッピングを行っています。
strURL = ThisWorkbook.Sheets("setting").Range("applicationServer") & _ ThisWorkbook.Sheets("setting").Range("odataService") & _
"(BusinessPartner='" & businessPartner & "',CreditSegment='" & creditSegment2 & "')" & _
"?sap-client=" & ThisWorkbook.Sheets("setting").Range("sapClient")
上記を実行すると以下の値になります。
URI を拡大した図です。
PATCH メソッドで更新を行う際は、BPコードと与信セグメントを URI に編集する必要があります。
' ヘッダー作成
httpReq.setRequestHeader "Authorization", "Basic " & sIdPass httpReq.setRequestHeader "Content-Type", "application/json; charset=UTF-8"
httpReq.setRequestHeader "Accept", "application/json" httpReq.setRequestHeader "X-CSRF-Token", token
' PATCHリクエスト送信
httpReq.send payload
Request Header の設定
CSRFトークンは (3) で取得した token をセットします。
PATCH メソッドのリクエストを送信(4)します。
' 取得結果をシートに記載
If httpReq.Status = 204 Then
'更新成功
cntSuccess = cntSuccess + 1
Else
'エラー
cntError = cntError + 1
End If
PATCH メソッドの実行が成功すると HTTP Status に 204 (成功) が返ります。
与信限度額一括更新を実行
VBA ソースコードを保存後、更新マクロの "vbaSheet"シートにある "申請データを読み与信限度額を一括更新する" ボタンをクリックして一括更新を実行します。
ソースコードが正しく作成できていて、申請データにも不具合がない場合、全件正常に更新されます。
ここで、1件エラーになるケースを発生させてみます。
・BPマスタ更新画面でレコードを開き、変更モードにしておく
・この状態で一括更新を実行する
・ロックされているため更新できず、1件エラーになる
・BPマスタ更新画面の変更モードを解除する
・エラーになったデータのみ "Update?(Y)" を "Y" にして、再度一括更新を実行する
・正常に更新できることを確認する
最後に
ここまで、S/4HANA の得意先 与信限度額を一括で更新するためのツールを作成しました。
Excel からの ODataサービス利用方法、更新系メソッド利用時の CSRF トークン設定手順などを説明しました。
S/4HANA に用意されている ODataサービス群を活用して、クリーンコアな拡張機能を提供していきましょう。
謝辞
"VBA-JSON" は Tim Hall氏が開発した JSON のパースに特化した VBAライブラリです。(MITライセンス)
・申請データファイルを読み、更新用シートにコピーする
・更新結果を申請データファイル側にも記録する
は、S/4HANA や ODataサービスの利用方法とは関係のない範囲のため、この記事では割愛させていただきました。
処理を実装するには少し手間がかかるため、この部分の処理実装・説明は個別案件での対応とさせてください。
更新履歴
2024/11/04 初版作成
2025/01/03 全体更新
2025/02/02 目次を追加