OData API でデータ操作

OData API を使えばSFs上のデータを簡単に参照＆編集できます。
ユーザー情報、カスタムMDFなど操作できるデータ範囲は幅広いです。

どのパソコンからでも操作可能にするために、サーバーではなくExcelで実装する例を記載しています。
APIキーと秘密鍵をマクロにベタ打ちしておけば、ログイン不要でボタン1つでデータ操作可能です。
（最低限のセキュリティとしてマクロはパスワードをかけたほうがよいです）

また、ユーザー情報ではなくカスタムMDFを操作する例にしています。
ユーザーに紐づいていないカスタムMDFを操作することによって、本来SFsと関係ない業務の改善にも組み込めます。
メール送付やファイル添付も組み合わせればいっちょまえの業務改革ができます。

分からないことがあればググるかSAP提供のドキュメントを見ましょう。
SAP提供のドキュメントはAPI知識がある人用に書かれているので注意。

メリット

通常は以下のような手順でデータを編集しているかと思います。

1. SFsにログインする
2. SFsで登録済みのデータのエクスポートジョブを実行する
3. ジョブが終わったらcsvをダウンロードする
4. csvをフォーマット通りに加工する（素人は文字コードエラーなど発生しやすい）
5. SFsに加工済みのcsvをインポートする
6. インポートジョブが正常に実行されたか確認する
7. 必要に応じてエラー対応する

OData APIをマクロに組み込んだExcelだとアホみたいに簡素化されます。

1. 「データ取得」ボタンをクリックする（最新のデータを数秒でExcel上に表示）
2. Excel上でデータを書き換える
3. 「データ登録」ボタンをクリックする（差分を判定してSFsにデータ登録）

1個テンプレを作成しておけば、項目IDを変えたりするだけで複製コストは殆どかかりません。
自動採番と組み合わせれば更に便利です。

SFsでの下準備

1. 「権限役割」画面でシステム管理者ユーザーにOData API関連の権限を付与する。
   「インテグレーションツールの管理」あたりの権限がそうです。
2. 「OData API 基本認証設定」画面で基本認証設定を「なし」に設定しておく。
   基本認証（ログインによる認証）よりも、秘密鍵による認証の方がセキュリティが高いと言われているので、基本認証はオフにします。ただし、IASへユーザーデータを連携している場合は連携が止まってしまうためオフにしない方がよいです。
3. 「APIセンター」画面で「ODataのOAuth設定」を選択し、「クライアントアプリケーションの登録」をクリックします。ここからAPIキーと秘密鍵を入手できます。
4. 「アプリケーション名」と「アプリケーションURL」を「OAuth」と「https://localhost/」とかでもなんでもいいので適当に入力し、「X.509証明書を生成」をクリックします。
5. 「Common Name(CN)」も適当に入力し、有効期限は10年分くらいにして「生成」をクリックします。
6. 「ダウンロード」をクリックします。ダウンロードされたファイルに秘密鍵が記載されています。ダウンロードできたら「登録」をクリックします。
7. 登録されたアプリケーションの「表示」をクリックし、自動生成されるAPIキーもメモっておきます。
8. 「オブジェクト定義の設定」画面から、データのは異なるMDFオブジェクトを新規作成します。
9. 変更履歴を残しておくとなにかと便利なので有効日の設定は「1日あたり複数回の変更」を選択するとよいと思います。API表示は「編集可能」、APIサブバージョンは「V1.1」にするのを忘れずに。最初はセキュアは「いいえ」にしておくといいのでは。

Excelでの下準備

1. マクロが有効化されたExcelファイル（*.xlsm）を作成します。
2. 開発タブを表示していなければこのサイトに従って表示します。
3. 開発タブからVisual Basic画面を開き、「ツール > 参照設定」で「Microsoft XML, v6.0」にチェックを入れます。API操作にはこれを使います。
4. ここの「Code > Download Zip」から「JsonConverter.bas」をダウンロードし、Visual Basic画面のプロジェクトウィンドウにドラッグ&ドロップして標準モジュールに追加します。APIで取得したJSON形式のデータを操作するのに使用します。Excelは32bitと64bitでできることが異なるため、どちらのバージョンでも操作できるように心がけてます。
5. ここからも同じように「Dictionary.cls」をダウンロードしてプロジェクトに追加します。これはDictionary形式のデータ型を操作できるようにするためです。
6. 開発タブの「挿入」をクリックし、左上の「ボタン」を選び、シートの1行目にボタンを作ります。
7. シートの2行目をヘッダー行にして、MDFオブジェクトの項目名を入力します。
   3行目からデータを表示する想定です。

データを取得するマクロコード

データを取得するためには以下の順番で処理を実施します。

0. 繰り返し実行する処理は関数として定義しておく
1. SAML Assertionを取得する（Access Tokenを取得するために必要）
2. Access Tokenを取得する（API操作をするために必要）
3. データを取得する

<>で囲われている箇所はインスタンスによって異なるので代入してください。

0. 関数の定義

繰り返し実行する処理は関数にしておくとコードがスッキリしますし、メンテナンスが楽になります。

'【関数】Dictionary形のパラメータをURL変換
Function encodeParams(pDic As Dictionary)
    
    Dim ary() As String
    ReDim ary(pDic.Count - 1) As String
    Dim i As Long
    For i = 0 To pDic.Count - 1
        ary(i) = pDic.Keys(i) & "=" & Application.WorksheetFunction.EncodeURL(pDic.Items(i))
    Next i
    encodeParams = Join(ary, "&")
End Function

自分は項目IDを変更するだけで他のオブジェクトに対応できるように、関数をパラメータ設定として利用してたりします。

'【パラメータ設定】項目IDと列名/セル名前のマッピング
Function getColumnNameMapping() As Object
Dim columnToNames As Object
Set columnToNames = CreateObject("Scripting.Dictionary")
    
'↓↓↓↓↓↓↓↓↓↓　ここから　↓↓↓↓↓↓↓↓↓↓
columnToNames.Add "externalCode", "ID"
columnToNames.Add "effectiveStartDate", "最終更新日"
columnToNames.Add "transactionSequence", "同日更新回数"
columnToNames.Add "externalName", "名称"
'↑↑↑↑↑↑↑↑↑↑　ここまで　↑↑↑↑↑↑↑↑↑↑
    
Set getColumnNameMapping = columnToNames
End Function

'【パラメータ設定】シート名とオブジェクトID
Function getSheetNames() As Object
Dim sheetNames As Object
Set sheetNames = CreateObject("Scripting.Dictionary")
    
'↓↓↓↓↓↓↓↓↓↓　ここから　↓↓↓↓↓↓↓↓↓↓
sheetNames.Add "single", "依頼票"
sheetNames.Add "list", "依頼票一覧"
sheetNames.Add "mdf_id", "cust_api_car"
'↑↑↑↑↑↑↑↑↑↑　ここまで　↑↑↑↑↑↑↑↑↑↑
    
Set getSheetNames = sheetNames
End Function

1. SAML Assertionの取得

'OData APIの権限が付与されているユーザー
Const company_id As String = "<カンパニーID>"
Const user_id As String = "<SFADMIN等>"

'SFsから取得したAPIキー
Const client_id As String = "<APIキー>"

'SFsで生成した証明書の秘密鍵（長いので10行くらいに分ける）
Const private_key   As String = _
    "<秘密鍵>" & _
    "<秘密鍵>" & _
    "<秘密鍵>"

'SAML Assertion取得用URL（APIのドメインは各サーバーで異なります）
Const idp_url As String = "https://<サーバーのURL>/oauth/idp?"

'パラメータ設定
Dim params As New Dictionary
params.Add "client_id", client_id
params.Add "user_id", user_id
params.Add "token_url", token_url
params.Add "private_key", private_key

'HTTPリクエスト
Dim httpReq As New XMLHTTP60
With httpReq
    .Open "POST", idp_url & encodeParams(params), False
    .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    .Send
    Do While .readyState < 4
        DoEvents
    Loop
End With

'HTTPリクエスト失敗したら中止
If httpReq.Status <> "200" And httpReq.Status <> "201" And httpReq.Status <> "204" Then
    MsgBox "APIへの接続に失敗しました", vbCritical
    End
End If

'SAML Assertionの格納
Dim saml_assertion As String
saml_assertion = httpReq.responseText

2. Access Tokenの取得

Access Tokenは24時間で失効するため、失効していた場合のみ再取得するようにすると綺麗です。

'Access Token取得用URL
Const token_url As String = "https://<サーバーのURL>/oauth/token?"

'パラメータ設定
params.RemoveAll
params.Add "client_id", client_id
params.Add "grant_type", "urn:ietf:params:oauth:grant-type:saml2-bearer"
params.Add "company_id", company_id
params.Add "assertion", saml_assertion
params.Add "new_token", "true"

'HTTPリクエスト
With httpReq
    .Open "POST", token_url & encodeParams(params), False
    .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    .Send
    Do While .readyState < 4
        DoEvents
    Loop
End With

'JSON形式のデータをパース
Dim responseObj As Object
Set responseObj = JsonConverter.ParseJson(httpReq.responseText)

'Access Tokenの格納
Dim access_token As String
access_token = responseObj("access_token")

'失効時間の格納（UNIX時間）
Dim unix_time As Long

Dim expire_at As Long
unix_time = DateDiff("s", "1970/1/1 9:00", Now)
expire_at = unix_time + responseObj("expires_in")

3. データの取得

64bitのExcelだとJSONの読み取り操作がしにくいので、XMLのフォーマットでデータを取得します。

’ODataのベースURL
Const odata_url As String = "https://<サーバーのURL>/odata/v2/"

'MDFデータ取得用のURL（取得したい項目を羅列する）
mdf_url = odata_url & "<MDFのオブジェクトID>?$format=atom&$select=externalCode,effectiveStartDate,transactionSequence,externalName"

'HTTPリクエスト
With httpReq
    .Open "GET", mdf_url, False
    .setRequestHeader "Authorization", "Bearer " & access_token
    .setRequestHeader "Accept", "application/atom+xml"
    .Send
    Do While .readyState < 4
        DoEvents
    Loop
End With

'XMLの解体
Dim doc As DOMDocument60
Set doc = New DOMDocument60
Dim XNodeList As IXMLDOMNodeList
Dim XNode As IXMLDOMNode
With doc
    .LoadXML (httpReq.responseText)
    .setProperty "SelectionLanguage", "XPath"
    .setProperty "SelectionNamespaces", "xmlns:m='http://schemas.microsoft.com/ado/2007/08/dataservices/metadata' xmlns:d='http://schemas.microsoft.com/ado/2007/08/dataservices'"
    Set XNodeList = .SelectNodes("//m:properties")
End With

'シートへの書き出し
Dim dateStr     As String
Dim nodeIndex   As Integer
nodeIndex = 0
For Each XNode In XNodeList
    For i = 0 To XNode.ChildNodes.Length - 1
        If XNode.ChildNodes.Item(i).BaseName = "externalCode" Then
                Worksheets("<シート名>").Cells(nodeIndex + 3, Range("A2:X2").Find("<ヘッダー>").Column).Value = XNode.ChildNodes.Item(i).nodeTypedValue
        ElseIf XNode.ChildNodes.Item(i).BaseName = "effectiveStartDate" Then
                dateStr = XNode.ChildNodes.Item(i).nodeTypedValue
                Worksheets("<シート名>").Cells(nodeIndex + 3, Range("A2:X2").Find("<ヘッダー>").Column).Value = Left(dateStr, InStr(dateStr, "T") - 1)
        ElseIf XNode.ChildNodes.Item(i).BaseName = "transactionSequence" Then
                Worksheets("<シート名>").Cells(nodeIndex + 3, Range("A2:X2").Find("<ヘッダー>").Column).Value = XNode.ChildNodes.Item(i).nodeTypedValue
        ElseIf XNode.ChildNodes.Item(i).BaseName = "externalName" Then
                Worksheets("<シート名>").Cells(nodeIndex + 3, Range("A2:X2").Find("<ヘッダー>").Column).Value = XNode.ChildNodes.Item(i).nodeTypedValue
        Else
            MsgBox "想定しない項目「" & XNode.ChildNodes.Item(i).BaseName & "」が読み込まれました。", vbCritical
            End
        End If
    Next
    nodeIndex = nodeIndex + 1
Next XNode

データを登録するマクロコード

ここからはAccess Token取得済みの前提です。

'現在のUNIX時間（ミリ秒）の取得
Dim unix_time_milli As String
unix_time_milli = DateDiff("s", "1970/1/1 9:00", Now) * 1000
    
'UTC日付（ISO8601形式）の取得
Dim dt As Object, utc As Date
Set dt = CreateObject("WbemScripting.SWbemDateTime")
dt.SetVarDate Now
utc = dt.GetVarDate(False)
Dim utc_ISO8601 As String
utc_ISO8601 = Format(utc, "yyyy-mm-dd") & "T" & Format(utc, "hh:nn:ss")

'MDF API URL
mdf_url = odata_url & "<MDFのオブジェクトID>"

'JSONオブジェクトの作成
Set JsonObject = New Dictionary
JsonObject.Add "__metadata", New Dictionary
JsonObject("__metadata").Add "uri", odata_url & "<MDFのオブジェクトID>(effectiveStartDate=datetime'" & utc_ISO8601 & "',externalCode='<登録したいデータのexternalCode>')"
JsonObject("__metadata").Add "type", "SFOData.<MDFのオブジェクトID>"
JsonObject.Add "externalCode", "<登録したいデータのexternalCode>"
JsonObject.Add "effectiveStartDate", "/Date(" & unix_time_milli & ")/"
JsonObject.Add "externalName", "<登録したいデータのexternalName>"
'連番は自動採番してくれるため不要
Debug.Print JsonConverter.ConvertToJson(JsonObject, Whitespace:=2)

'HTTPリクエスト
With httpReq
    .Open "POST", mdf_url, False
    .setRequestHeader "Authorization", "Bearer " & access_token
    .setRequestHeader "Content-Type", "application/json"
    .Send JsonConverter.ConvertToJson(JsonObject)
    Do While .readyState < 4
        DoEvents
    Loop
End With
            
'HTTPリクエスト失敗したら中止
If httpReq.Status <> "200" And httpReq.Status <> "201" And httpReq.Status <> "204" Then
    MsgBox "行" & i & "のデータ登録に失敗しました。" & vbCrLf & httpReq.Status & vbCrLf & httpReq.responseText, vbCritical
    End
End If

データを削除するマクロコード

削除は1レコードずつしかできないため、履歴をまるごと消したい場合は以下の順番で処理する。

1. 完全パージで1件のレコードを挿入
2. 挿入したレコードの削除

'MDF API URL
mdf_url = odata_url & "upsert?purgeType=full"

'JSONオブジェクトの作成
Set JsonObject = New Dictionary
JsonObject.Add "__metadata", New Dictionary
JsonObject("__metadata").Add "uri", "<MDFのオブジェクトID>(effectiveStartDate=datetime'1900-01-01T00:00:00',externalCode='<削除したいデータのexternalCode>')"
                  
'HTTPリクエスト
With httpReq
    .Open "POST", mdf_url, False
    .setRequestHeader "Authorization", "Bearer " & access_token
    .setRequestHeader "Content-Type", "application/json"
    .Send JsonConverter.ConvertToJson(JsonObject)
    Do While .readyState < 4
        DoEvents
    Loop
End With

'MDF API URL
mdf_url = odata_url & "<MDFのオブジェクトID>(effectiveStartDate=datetime'1900-01-01T00:00:00',transactionSequence='1',externalCode='<削除したいデータのexternalCode>')"

'HTTPリクエスト
With httpReq
    .Open "DELETE", mdf_url, False
    .setRequestHeader "Authorization", "Bearer " & access_token
    .Send
    Do While .readyState < 4
        DoEvents
    Loop
End With