【Excel VBA⇔Cloud】Dataverse Web API データ検索&更新2

Excel VBA ⇔ Cloud データ検索&更新(Dataverse Web API)２

前の記事の続きになります。
Excel VBAでDataverse Web APIを使用して、クラウド上にあるDataverseのテーブルのデータ検索・更新を行う方法を紹介します。

操作環境：

OS：Windows 11
Webブラウザー：Edge

使用プラン：Microsoft 365 Business Premium(*)
*DataverseのテーブルおよびWeb APIにアクセスできる組織アカウントでサインインしていること

PostmanによるAPI動作確認(推奨)
Excel VBAによるデータ検索実装
Excel VBAによるデータ更新実装
おわりに

PostmanによるAPI動作確認(推奨)

いきなりVBAで実装するのではなく、先にAPI開発ツール「Postman」で認証およびデータ検索・更新時のデータのやりとりを確認することをおススメします。
Postmanの入手方法は以前の記事を参考にしてください。
ここからこの例におけるPostmanの設定および動作確認の方法を紹介します。

まずは環境を新規作成します。コレクションに直接設定値をベタ打ちもできますが、同じ接続先に色々なリクエストを試したい場合、ここで設定を変数化しておくと便利です。また、機密情報はタイプをシークレットにしています。

url：前の記事の工程4の最後に控えたWeb APIエンドポイントのhttps://xxxxxx.api.xxx.dynamics.com部分
tenant_id：前の記事の工程2で控えたディレクトリ(テナント)ID
access_token_url：https://login.microsoftonline.com/{{tenant_id}}/oauth2/v2.0/token
client_id：前の記事の工程2で控えたアプリケーション(クライアント)ID
client_secret：前の記事の工程2の最後に控えたクライアントシークレット
scope：{{url}}/.default
grant_type：client_credentials

*{{xxx}}はxxxという変数として扱われます

コレクションにデータ検索用のリクエストを新規作成します。

メソッド：GET
URL：{{url}}/api/data/v9.2/crc89_book_tables
*テーブル名は前の記事の工程4で確認したプリフィックス付きの値とし、最後にsを付加します

*この例では全件検索としています
ヘッダー>Accept：application/json

[認可]タブを選択し、左側の項目を以下の通りとします。

Auth Type：OAuth 2.0
認可データの追加先：リクエストヘッダー

同じ画面の下の方の[新しいトークンの設定]を以下の通り設定し、[新しいアクセストークンを取得]を選択します。

トークン名：(適宜設定)
Grantタイプ：クライアント資格認証
アクセストークンURL：{{access_token_url}}
クライアントID：{{client_id}}
クライアントシークレット：{{client_secret}}
Scope：{{scope}}
クライアント認証：Basic認証ヘッダーとして認証
トークンリクエスト：

キー：grant_type
値：{{grant_type}}
追加先：Request Body

アクセストークンが作成されたら、[Proceed]を選択します。
[Use Token]を選択します。

[現在のトークン]の[トークン]欄に作成されたトークンの値が反映されます。
ヘッダー接頭辞が[Bearer]になっていることを確認し、[送信]を選択します。

リクエスト送信結果は画面下部に表示されます。
データ検索の場合はテーブルのデータがJson型で表示されます。
データ取得結果の中に(この画面イメージでは一番下に表示)、crc89_book_tableidという項目があります。これはDataverseのテーブルで自動採番される一意の値を格納します。Web APIでデータ変更・削除を行う際のキーとして使用します。

データ追加の場合は、以下のような設定となります。

メソッド：POST
URL： {{url}}/api/data/v9.2/crc89_book_tables
[認可]タブ：(データ取得時と同じ)
ヘッダー>Content-Type：application/json
[ボディ]タブ：(追加対象データをJson型で設定)(*)
*{ "name1":value1(num), "name2":"value2(string)","name3","value3(yyyy-mm-dd)" }のような形となります

データ変更の場合は、以下のような設定となります。

メソッド：PATCH
URL： {{url}}/api/data/v9.2/crc89_book_tables(<crc89_book_tablleidの値>)
[認可]タブ：(データ検索・追加・削除時と同じ)
ヘッダー>Content-Type：(データ追加・削除時と同じ)
[ボディ]タブ：(データ追加時と同様、変更対象データをJson型で設定)

データ削除の場合は、以下のような設定となります。

メソッド：DELETE
URL： (データ変更時と同じ)
[認可]タブ：(データ検索・追加・変更時と同じ)
ヘッダー>Content-Type：(データ追加・変更時と同じ)

以下は参考情報です。
前の記事の工程2の設定を行わず、まずはPostmanでDataverseへの接続を試したい場合の手順が公式記事に掲載されています。また、この手順を使用した場合、Dataverse for Teamsのテーブルに対してもデータ検索できました。

Excel VBAによるデータ検索実装

データ検索のメインとなるプロシージャのソースです。以下がポイント事項です。

API実行時の認証情報は、[Authorization]というキー名で、[Bearer <アクセストークン>](アクセストークンはサブ関数で取得)の値をHTTPヘッダーに渡している
検索結果はJson型の変数apiJsonで取得し、エラーがあれば詳細情報をダイアログ表示する。なお、エラー発生時のレスポンスの書式はこちらの記事を参考にしている
Dataverseのテーブルで自動採番されるキー項目も取得対象とした(この例ではcrc89_book_tableid列)
検索が正常終了した時のデータの取り出し方法は、Postmanでデータ検索を実行した時の書式に基づいている

Private Sub searchDataverseBook()

  '変数宣言
  Dim wb As Workbook
  Dim ws As Worksheet
  Dim apiMethod As String
  Dim apiUrl As String
  Dim apiBody As String
  Dim apiParams As String
  Dim apiHeaders As New Dictionary
  Dim apiJson As Object
  Dim keys  As Variant
  Dim cnt_row As Long
  Dim cnt_col As Long
  
  '出力先ワークシートの設定 、データ初期化
  Set wb = ThisWorkbook
  Set ws = wb.Worksheets("Search")
  ws.Rows("1:" & ws.Range("A" & ws.Rows.Count).End(xlUp).Row).Delete
  
  'データ検索
  apiMethod = "GET"
  apiUrl = "https://xxxxxx.api.xxx.dynamics.com/api/data/v9.2/crc89_book_tables"
  apiBody = ""
  apiParams = ""
  apiHeaders.RemoveAll
  apiHeaders.Add "Accept", "application/json"
  apiHeaders.Add "Authorization", getAccessToken() 'トークン取得
  Set apiJson = callRestApi(apiMethod, apiUrl, apiBody, apiParams, apiHeaders)
  
  'データ検索でエラーが発生した場合、ダイアログを表示する
  If apiJson.Exists("error") Then
    MsgBox "データ検索でエラーが発生しました。:" & apiJson("error")("code") & _
      ":" & apiJson("error")("message"), vbOKOnly, "データ検索エラー"
    Exit Sub
  End If
  
  '取得データ項目を定義する(crc89_book_tableidはDataverseにて
  '自動割当されるレコードIDで、更新・削除時にキーとして使用)
  keys = Array("crc89_book_tableid", "crc89_id", "crc89_category", "crc89_status", _
    "crc89_borrower", "crc89_borrowed_date", "crc89_isbn_code", _
    "crc89_published_date", "crc89_book_name", "crc89_author", _
    "crc89_publisher", "crc89_memo", "crc89_thumbnail")

  'レコードセットsearchシートに書き出す
  For cnt_row = 0 To apiJson("value").Count - 1
    For cnt_col = 0 To UBound(keys)
      If cnt_row = 0 Then
        ws.Cells(cnt_row + 1, cnt_col + 1) = keys(cnt_col) 'タイトル行の書き出し
      End If
      ws.Cells(cnt_row + 2, cnt_col + 1) = _
        "'" & apiJson("value")(cnt_row + 1)(keys(cnt_col)) 'データ行の書き出し
    Next cnt_col
  Next cnt_row
  
End Sub

データ検索のメインプロシージャから呼び出しているサブ関数のソースです(アクセストークン取得、API実行)。以下がポイント事項です。

API実行関数は、アクセストークン取得やデータの検索・変更・削除で共通の関数としたため、それぞれの処理で不要なパラメータも一旦渡す扱う形とした(例えばアクセストークン取得時、params,headerは不要だが、引数として一旦渡している)
API実行関数の最後に、前の記事の工程5でインポートしたJsonConverterのJson型変換関数を呼び出している。この関数は戻り値がNothing(データ更新が正常終了したとき)だとエラー扱いとなるため、一旦これをスルーして、メインプロシージャでエラー判定することとした

'*****************************************
' getAccessToken：アクセストークン取得
'*****************************************
Private Function getAccessToken() As String

  Dim apiMethod As String
  Dim apiUrl As String
  Dim apiBody As String
  Dim apiParams As String
  Dim apiHeaders As New Dictionary
  Dim apiJson As Object

  'リクエスト情報の格納
  apiMethod = "POST"
  apiUrl = "https://login.microsoftonline.com/{テナントID}/oauth2/v2.0/token"
  apiBody = "client_id={クライアントID}" & _
    "&client_secret={クライアントシークレット}" & _
    "&grant_type=client_credentials" & _
    "&scope=https://xxxxxx.api.xxx.dynamics.com/.default"
  apiParams = ""
  apiHeaders.RemoveAll
  
  'レスポンスをJsonに格納する
  Set apiJson = callRestApi(apiMethod, apiUrl, apiBody, apiParams, apiHeaders)
  
  'Json型からアクセストークンを取り出して返す
  getAccessToken = apiJson("token_type") & " " & apiJson("access_token")

End Function


'*****************************************
' callRestApi：API実行(アクセストークン取得時を含む)
'*****************************************
Private Function callRestApi(method As String, url As String, body As String, params As String, headers As Dictionary) As Object

  Dim http As Object
  Dim cnt As Long
  
  'データ更新の正常終了時、戻り値がNothingのため
  'ParseJsonでエラー扱いになる。これをスルーする
  On Error Resume Next
  
  'httpリクエストオブジェクトの設定
  Set http = CreateObject("msxml2.xmlhttp") '参照設定Microsoft Scripting Runtime必要
  http.Open method, url & params, False
  
  'httpリクエストヘッダーの設定
  For cnt = 0 To headers.Count - 1
    http.setRequestHeader headers.keys(cnt), headers.Items(cnt)
  Next cnt
  
  'リクエスト送信
  If body = "" Then
    http.send
  Else
    http.send (body)
  End If
  
  'レスポンスの文字列をJson型に変換して返す
  Set callRestApi = JsonConverter.ParseJson(http.responseText)

End Function

*{テナントID}、{クライアントID}、{クライアントシークレット}は前の記事の工程2で確認した値とし、カッコ{ }は不要です

Excel VBAによるデータ更新実装

データ更新(追加・変更・削除)のメインとなるプロシージャのソースです。ポイント事項はデータ検索のメイン関数と同じです。

Private Sub renewDataverseBook()
  
  '変数宣言
  Dim wb As Workbook
  Dim ws As Worksheet
  Dim apiMethod As String
  Dim apiUrl As String
  Dim apiBody As String
  Dim apiParams As String
  Dim apiHeaders As New Dictionary
  Dim apiJson As Object
  Dim keys  As Variant
  Dim cnt_row As Long
  Dim cnt_col As Long
  Dim array_name As Variant
  Dim array_value As Variant
  
  '出力先ワークシートの設定
  Set wb = ThisWorkbook
  Set ws = wb.Worksheets("Renew")

  'Renewシートの最大行列数を求め、データ反映で使用するvariant変数のサイズを定義する
  max_row = ws.Range("A" & ws.Rows.Count).End(xlUp).Row - 1
  max_col = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column - 1
  ReDim array_name(max_col - 2)
  ReDim array_value(max_col - 2)
  
  'データ反映対象のタイトル行をvariant変数に格納する(action,crc89_book_tableid列をのぞく)
  For cnt_col = 0 To max_col - 2
    array_name(cnt_col) = ws.Cells(cnt_row + 1, cnt_col + 3)
  Next cnt_col
  
  apiParams = "" 'データ更新では設定値がないので空文字とする
  
  For cnt_row = 0 To max_row - 1
  
    'データ反映対象のデータ行をvariant変数に格納する(action,crc89_book_tableid列をのぞく)
    For cnt_col = 0 To max_col - 2
      If ws.Cells(cnt_row + 2, cnt_col + 3) <> "" Then
        array_value(cnt_col) = ws.Cells(cnt_row + 2, cnt_col + 3).Value
      Else
        array_value(cnt_col) = Null
      End If
    Next cnt_col
    
    'HTTPヘッダーの初期化・格納
    apiHeaders.RemoveAll
    apiHeaders.Add "Content-Type", "application/json"
    apiHeaders.Add "Authorization", getAccessToken() 'トークン取得
    
    'HTTPメソッド,Url,Bodyの格納
    If ws.Cells(cnt_row + 2, 1).Value = "ins" Then 'データ追加
      apiMethod = "POST"
      apiUrl = "https://xxxxxx.api.xxx.dynamics.com/api/data/v9.2/crc89_book_tables"
      apiBody = getBody(array_name, array_value) 'ボディ格納
    ElseIf ws.Cells(cnt_row + 2, 1).Value = "upd" Then 'データ変更
      apiMethod = "PATCH"
      apiUrl = "https://xxxxxx.api.xxx.dynamics.com/api/data/v9.2/crc89_book_tables(" & ws.Cells(cnt_row + 2, 2).Value & ")"
      apiBody = getBody(array_name, array_value) 'ボディ格納
    ElseIf ws.Cells(cnt_row + 2, 1).Value = "del" Then 'データ削除
      apiMethod = "DELETE"
      apiUrl = "https://xxxxxx.api.xxx.dynamics.com/api/data/v9.2/crc89_book_tables(" & ws.Cells(cnt_row + 2, 2).Value & ")"
      apiBody = ""
    End If
    
    'リクエスト送信・レスポンス格納
    Set apiJson = callRestApi(apiMethod, apiUrl, apiBody, apiParams, apiHeaders) 
    
    'エラーが発生した場合、ダイアログを表示する
    If Not apiJson Is Nothing Then
      If apiJson.Exists("error") Then
        MsgBox CStr(cnt_row + 1) & "番目のデータ反映でエラーが発生しました。:" & _
          apiJson("error")("code") & ":" & apiJson("error")("message"), vbOKOnly, _
          "データ反映エラー"
      End If
    End If
    
  Next cnt_row
  
End Sub

データ更新のメインプロシージャから呼び出しているサブ関数(データ検索と重複する関数を除く)のソースです(ボディ格納)。以下がポイント事項です。

ソースの最初のコメント部分に記載した通り、データの型に合わせて、値を"で囲む/囲まない、日付の形式の調整といった処理を行っている

'*****************************************
' getBody：ボディ格納(データ追加・変更用)
' { "name1":value1(num), "name2":"value2(string)","name3","value3(yyyy-mm-dd)" }
'*****************************************
Private Function getBody(array_name As Variant, array_value As Variant) As String

  Dim cnt_col As Long
  Dim apiBody As String
  
  apiBody = "{"
  For cnt_col = 0 To UBound(array_name)
    If IsNull(array_value(cnt_col)) = False Then
      If cnt_col > 0 Then
        apiBody = apiBody & ","
      End If
      If array_name(cnt_col) = "crc89_id" Then '数値型の列
        apiBody = apiBody & """" & array_name(cnt_col) & """" & ":" _
          & array_value(cnt_col)
      ElseIf array_name(cnt_col) = "crc89_borrowed_date" Or _
        array_name(cnt_col) = "crc89_published_date" Then  '日付型の列
        apiBody = apiBody & """" & array_name(cnt_col) & """" & ":" _
          & """" & Replace(array_value(cnt_col), "/", "-") & """"
      Else 'その他の型の列
        apiBody = apiBody & """" & array_name(cnt_col) & """" & ":" _
          & """" & array_value(cnt_col) & """"
      End If
    End If
  Next
  apiBody = apiBody & "}"
    
  'Bodyの値を返す
  getBody = apiBody

End Function

おわりに

Dataverse Web APIに関しては、前の記事で紹介したMicrosoft Entra管理センターやPower Platform管理センターでの初期設定が少々面倒ですが、一度設定してしまえばそれほど煩わしくありません。

Dataverseに限らずAPIに対応しているクラウドサービスであれば、APIを使用することで、クラウド上のデータに対して検索・更新ができるようになります。
各種通知やデータ連携の自動化といった業務効率化の足掛かりになりますので、参考まで主要なクラウドサービスのAPIドキュメントのリンクを掲載します。

当ブログ内の連載記事

elmgrn.hatenablog.com

当ブログ内の関連記事