前の記事の続きになります。
Excel VBAでMicrosoft Graph REST APIを使用して、SharePoint Online上にあるExcelファイル(テーブル未使用)のデータ検索・更新を行う方法を紹介します。
Excel VBAでMicrosoft Graph REST APIを使用して、SharePoint Online上にあるExcelファイル(テーブル未使用)のデータ検索・更新を行う方法を紹介します。
- 操作環境(*)：
- OS:Windows 11
- Webブラウザー:Edge
- 使用プラン：Microsoft 365 Business Premium
*SharePoint Online上のExcelファイルおよびMicrosoft Graph REST APIにアクセスできる組織アカウントでサインインしていること
なお、この記事では、VBAの使用許可や開発メニュー表示といった初期設定や、VBAエディタの使い方の説明は割愛いたします。
PostmanによるExcel操作確認(推奨)
対応必須ではありませんが、VBAでの実装イメージ確認のため、Postmanでセッション取得、セル範囲を指定したデータ検索・更新を試してみます。
- セッション：公式記事によると、永続セッションが最も効率的でパフォーマンスが高いようです。VBA実装時にこれを使用してみます。
- データ検索：使用済のセル範囲のデータを取得するAPIを使用します。
- データ更新：指定したセル範囲のデータを更新するAPIを使用します。セル範囲を操作するAPIでは、SQLのような条件によるデータ抽出ができません。VBA実装時はデータ検索結果から更新すべきセル範囲を特定する必要があります。
- 追加：使用済セル範囲の一行下にデータを反映
- 変更：データ検索結果から更新すべきセル範囲を特定し、データを更新
- 削除：データ検索結果から更新すべきセル範囲を特定し、データを更新(削除フラグを立てる)(*)
*指定したセル範囲の行削除ができるAPIもありますが、行削除とデータ再検索が非同期で処理され、順序が逆転し、後続のセル範囲特定でズレが生じることがあります。セル範囲による操作では対処が困難だったため、データの物理削除は行わず、削除フラグを立てるデータ更新処理としました
セッションID取得
前の記事の工程6-2で追加したサイトID取得の設定で[・・・＞Duplicate]を選択し(画面イメージは割愛) 、セッションID取得の設定を追加します。
- メソッド：POST
- URL：https://graph.microsoft.com/v1.0/sites/{{site_id}}
/drive/items/{{file_id}}/workbook/createSession*上記URLは表示の都合で改行が入っていますが、使用時は改行を削除します*{{xxx}}はxxxという変数として扱われます - Headers＞Content-type：application/json
- Body：{ "persistChanges":true }
前の記事のサイトID取得時と同様に[Authorization]タブでアクセストークン取得を経て、[Send]を実行します。
画面下部に結果が表示されたら、最上位層の"id":"xxx"のxxx部分がセッションIDになります。
データ検索
工程7-1で追加したセッションID取得の設定で[・・・＞Duplicate]を選択し(画面イメージは割愛)、データ検索の設定を追加します。
- メソッド：GET
- URL：https://graph.microsoft.com/v1.0/sites/{{site_id}}
/drive/items/{{file_id}}/workbook/worksheets/data/usedRange*上記URLは表示の都合で改行が入っていますが、使用時は改行を削除します*{{xxx}}はxxxという変数として扱われます - Headers＞Content-type：application/json
*セッションの使用はここでは割愛しています
セッションID取得時と同様に[Authorization]タブでアクセストークン取得を経て、[Send]を実行します。
画面下部に結果が表示されたら、最上位層の"values"の中身が検索結果(値)になります。
データ更新
工程7-2で追加したデータ検索の設定で[・・・＞Duplicate]を選択し(画面イメージは割愛)、データ更新の設定を追加します。
- メソッド：PATCH
- URL：https://graph.microsoft.com/v1.0/sites/{{site_id}}
/drive/items/{{file_id}}/workbook/worksheets/data/range(address="(セル範囲)")*上記URLは表示の都合で改行が入っていますが、使用時は改行を削除します*{{xxx}}はxxxという変数として扱われます - Headers＞Content-type：application/json
*セッションの使用はここでは割愛しています
- Body：{"values":［［(設定したい列の値をカンマ区切りで設定)］］}
*上記記述内の大カッコは表示の都合で全角としていますが、使用時は半角にしてください
データ検索時と同様に[Authorization]タブでアクセストークン取得を経て、[Send]を実行します。
データ削除(参考)
VBA実装時は使用しませんが、対象データを行削除する場合の設定を紹介します。工程7-3で追加したデータ更新の設定で[・・・＞Duplicate]を選択し(画面イメージは割愛)、データ削除の設定を追加します。
- メソッド：POST
- URL：https://graph.microsoft.com/v1.0/sites/{{site_id}}/drive/items/
{{file_id}}/workbook/worksheets/data/range(address="(セル範囲)")/delete*上記URLは表示の都合で改行が入っていますが、使用時は改行を削除します*{{xxx}}はxxxという変数として扱われます - Headers＞Content-type：application/json
*セッションの使用はここでは割愛しています - Body：{"shift":"Up"}
*Bodyの記述により、データ削除後に行を上に詰める処理が行われます
データ更新時と同様に[Authorization]タブでアクセストークン取得を経て、[Send]を実行します。
Excel VBAによるデータ検索実装
データ検索のメインとなるプロシージャ(searchSPExcelBook)のソースです。ポイント事項は以下の通りです。
- トークン更新後、セッションID取得・データ検索を行い、検索結果をSearchシートに書き出している
- 検索結果はJson型の変数apiJsonで取得し、エラーがあれば詳細情報をダイアログ表示用の変数に格納する
- 検索が正常終了した時のデータの取り出し方法は、Postmanでデータ検索を実行した時の書式に基づいている("values"内の配列データを出力)
Private Sub searchSPExcelBook(message, title)
'変数宣言(Excel関連)
Dim wb As Workbook
Dim ws As Worksheet
Dim ws_param As Worksheet
'変数宣言(API関連)
Dim apiJson As Object
'変数宣言(処理変数)
Dim cnt_row As Long
Dim cnt_col As Long
'ワークシートの設定&初期化
Set wb = ThisWorkbook
Set ws_param = wb.Worksheets("param")
Set ws = wb.Worksheets("Search")
ws.Rows("1:" & ws.Range("A" & ws.Rows.Count).End(xlUp).Row).Delete
'トークン更新、セッション取得
Call refreshTokens(ws_param)
Call setSession(ws_param)
'データ検索
Set apiJson = getSearchData(ws_param)
'データ検索でエラーが発生した場合、引数に結果を格納し終了
If apiJson.Exists("error") Then
message = "データ検索でエラーが発生しました。:" & _
apiJson("error")("code") & ":" & apiJson("error")("message")
title = "データ検索エラー"
Exit Sub
End If
'データ検索結果をSearchシートに書き出す
For cnt_row = 0 To apiJson("values").Count - 1
For cnt_col = 0 To apiJson("columnCount") - 1
If cnt_row = 0 Or cnt_col = 0 Then 'タイトル行またはID列
ws.Cells(cnt_row + 1, cnt_col + 1) = apiJson("values")(cnt_row + 1)(cnt_col + 1)
Else 'ID列以外のデータ行
ws.Cells(cnt_row + 1, cnt_col + 1) = "'" & apiJson("values")(cnt_row + 1)(cnt_col + 1)
End If
Next cnt_col
Next cnt_row
End Sub
データ検索のメインプロシージャから呼び出しているサブ関数・サブプロシージャのソースです。ポイント事項は以下の通りです。
- refreshTokens(トークン更新)：実行結果をparamsシートのaccess_tokenとrefresh_tokenに格納している
- setSession(セッションID取得)：実行結果をparamsシートのsession_idに格納している
- getSearchData(データ検索)：setSessionで取得したセッションIDを、リクエストヘッダー"workbook-session-id"に設定して使用している
- callRestApi(API実行)：
- 変数httpの設定について、これまで紹介したVBAによるAPI実行の記事と異なり(例:API×SharePointリスト)、「Set http = CreateObject("msxml2.xmlhttp")」が使用できないため、TLS1.2対応版の記述とした
- トークン更新・セッションID取得・データ検索・データ更新で共通の関数としたため、それぞれの処理で不要なパラメータも一旦渡す扱う形とした(例えばトークン更新時やセッションID取得時にapiParamsの設定は不要だが、引数として渡している)
- 前の記事の工程4でインポートしたJsonConverterのJson型変換関数を呼び出している。この関数は戻り値がNothing(データ削除が正常終了したとき)だとエラー扱いとなるため、一旦これをスルーして、メインプロシージャでエラー判定することとした
'*****************************************
' refreshTokens：GraphAPIのトークンを更新する
'*****************************************
Private Sub refreshTokens(ws_param As Worksheet)
'変数宣言(API関連)
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/" & _
ws_param.Cells(8, 2).Value & "/oauth2/v2.0/token"
apiBody = "grant_type=refresh_token&scope=Files.ReadWrite"
apiBody = apiBody & "&client_id=" & ws_param.Cells(3, 2).Value
apiBody = apiBody & "&client_secret=" & ws_param.Cells(4, 2).Value
apiBody = apiBody & "&refresh_token=" & ws_param.Cells(2, 2).Value
apiParams = ""
apiHeaders.RemoveAll
apiHeaders.Add "Content-Type", "application/x-www-form-urlencoded"
'アクセストークン取得・出力
Set apiJson = callRestApi(apiMethod, apiUrl, apiBody, apiParams, apiHeaders)
ws_param.Cells(1, 2).Value = apiJson("access_token")
ws_param.Cells(2, 2).Value = apiJson("refresh_token")
End Sub
'*****************************************
' setSession：GraphAPIのセッションIDを格納する
'*****************************************
Private Sub setSession(ws_param As Worksheet)
'変数宣言(API関連)
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://graph.microsoft.com/v1.0/sites/" & _
ws_param.Cells(5, 2).Value & "/drive/items/" & _
ws_param.Cells(6, 2).Value & "/workbook/createSession"
apiBody = "{" & """" & "persistChanges" & """" & ":true}"
apiParams = ""
apiHeaders.RemoveAll
apiHeaders.Add "Content-type", "application/json"
apiHeaders.Add "Authorization", "Bearer " & ws_param.Cells(1, 2).Value
'セッション取得・出力
Set apiJson = callRestApi(apiMethod, apiUrl, apiBody, apiParams, apiHeaders)
ws_param.Cells(7, 2).Value = apiJson("id")
End Sub
'*****************************************
' getSearchData：データ検索をして結果を返す
'*****************************************
Private Function getSearchData(ws_param As Worksheet) As Object
'変数宣言(API関連)
Dim apiMethod As String
Dim apiUrl As String
Dim apiBody As String
Dim apiParams As String
Dim apiHeaders As New Dictionary
'データ検索
apiMethod = "GET"
apiUrl = "https://graph.microsoft.com/v1.0/sites/" & _
ws_param.Cells(5, 2).Value & "/drive/items/" & _
ws_param.Cells(6, 2).Value & "/workbook/worksheets/data/usedRange"
apiBody = ""
apiParams = ""
apiHeaders.RemoveAll
apiHeaders.Add "Content-type", "application/json"
apiHeaders.Add "Authorization", "Bearer " & ws_param.Cells(1, 2).Value
apiHeaders.Add "workbook-session-id", ws_param.Cells(7, 2).Value
'API実行
Set getSearchData = callRestApi(apiMethod, apiUrl, apiBody, apiParams, apiHeaders)
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リクエストオブジェクトの設定(照設定でMicrosoft Scripting Runtimeが必要)
'Set http = CreateObject("msxml2.xmlhttp")
Set http = CreateObject("WinHttp.WinHttpRequest.5.1") 'TLS1.2対応版でないと動作しない
http.Option(6) = True
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
Excel VBAによるデータ更新実装
データ更新のメインとなるプロシージャ(renewSPExcelBook)のソースです。ポイント事項は以下の通りです。
- トークン更新後、セッションID取得・データ検索を行い、データ検索結果を元に更新すべきセル範囲を特定し、データ更新を行っている
- last_rowはデータ追加時のセル範囲を特定するための変数で、データ検索結果の最終行の一行後が更新すべき行となる
- new_idはデータ追加時のID列の自動採番用変数で、データ検索結果のID列の最大値の+1が設定すべき値となる
- データ削除のコメントアウトしたソースは、行削除を行う場合の実装例となる。行削除後にデータの再検索が必要となるが、この記事の冒頭で注記した通り、行削除が遅延しデータ再検索と順序が逆転して正常に処理できないことがあるため、行削除は実装しなかった
Private Sub renewSPExcelBook(message, title)
'変数宣言(Excel関連)
Dim wb As Workbook
Dim ws As Worksheet
Dim ws_param As Worksheet
'変数宣言(API関連)
Dim apiJson_db As Object 'データ検索結果
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 cnt_row_db As Long 'データ検索結果の行カウンタ
Dim cnt_row As Long 'データ更新対象の行カウンタ
Dim max_row As Long 'データ更新対象の最大行数
Dim last_row As Long '最終行(データ追加用)
Dim new_id As Long 'ID最大値(データ追加用)
Dim data_range As String '更新範囲(データ変更・削除用)
'出力先ワークシートの設定
Set wb = ThisWorkbook
Set ws_param = wb.Worksheets("param")
Set ws = wb.Worksheets("Renew")
'Renewシートの最大行数を求める(タイトル行は除く)
max_row = ws.Range("A" & ws.Rows.Count).End(xlUp).Row - 1
'トークン更新、セッション取得
Call refreshTokens(ws_param)
Call setSession(ws_param)
'データ検索
Set apiJson_db = getSearchData(ws_param)
'データ検索でエラーが発生した場合、引数に結果を格納し終了
If apiJson_db.Exists("error") Then
message = "データ検索でエラーが発生しました。:" & _
apiJson_db("error")("code") & ":" & apiJson_db("error")("message")
title = "データ検索エラー"
Exit Sub
End If
'検索結果から最終行とID列の最大値を求める
last_row = apiJson_db("values").Count
new_id = getNewId(apiJson_db)
'API変数設定(共通)
apiHeaders.RemoveAll
apiHeaders.Add "Content-type", "application/json"
apiHeaders.Add "Authorization", "Bearer " & ws_param.Cells(1, 2).Value
apiHeaders.Add "workbook-session-id", ws_param.Cells(7, 2).Value
apiMethod = "PATCH"
For cnt_row = 0 To max_row - 1 '更新対象ループ
'データ追加:API変数の設定(個別)
If ws.Cells(cnt_row + 2, 1).Value = "ins" Then
apiUrl = "https://graph.microsoft.com/v1.0/sites/" & _
ws_param.Cells(5, 2).Value & "/drive/items/" & _
ws_param.Cells(6, 2).Value & "/workbook/worksheets/data/range(address='A" & _
CStr(last_row + 1) & ":M" & CStr(last_row + 1) & "')"
apiBody = getBody(ws, cnt_row, new_id + 1)
'データ変更,削除:更新セル範囲の特定(ID列の値が一致する行)
Else
For cnt_row_db = 0 To apiJson_db("values").Count - 2 '検索結果ループ(タイトル行は除く)
If apiJson_db("values")(cnt_row_db + 2)(1) = ws.Cells(cnt_row + 2, 2).Value Then
data_range = "A" & CStr(cnt_row_db + 2) & ":M" & CStr(cnt_row_db + 2)
Exit For
End If
Next cnt_row_db
'データ削除
If ws.Cells(cnt_row + 2, 1).Value = "del" Then
'削除フラグを立てて更新
ws.Cells(cnt_row + 2, 14).Value = "'1"
'行削除:行削除後の再検索が先に実行されることがあり実現困難
'apiMethod = "POST"
'apiUrl = "https://graph.microsoft.com/v1.0/sites/" & _
' ws_param.Cells(5, 2).Value & "/drive/items/" & _
' ws_param.Cells(6, 2).Value & _
' "/workbook/worksheets/data/range(address='" & data_range & "')/delete"
'apiBody = "{" & """" & "shift" & """" & ":" & """" & "Up" & """" & "}"
End If
'データ変更,削除:API変数の設定(個別)
apiUrl = "https://graph.microsoft.com/v1.0/sites/" & ws_param.Cells(5, 2).Value & _
"/drive/items/" & ws_param.Cells(6, 2).Value & _
"/workbook/worksheets/data/range(address='" & data_range & "')"
apiBody = getBody(ws, cnt_row, ws.Cells(cnt_row + 2, 2).Value)
End If
'データ反映実行(API実行)
Set apiJson = callRestApi(apiMethod, apiUrl, apiBody, apiParams, apiHeaders)
'データ反映でエラーが発生した場合、ダイアログを表示する
If Not apiJson Is Nothing Then
If apiJson.Exists("error") Then
message = CStr(cnt_row + 2) & "番目のデータ反映でエラーが発生しました。:" & _
apiJson("error")("code") & ":" & apiJson("error")("message")
title = "データ反映エラー"
GoTo NextLoop
End If
End If
'データ追加:最終行とID列の最大値をカウントアップ
If ws.Cells(cnt_row + 2, 1).Value = "ins" Then
last_row = last_row + 1
new_id = new_id + 1
'データ削除:行削除後の再検索,最終行とID列の最大値の再算出
'(行削除後の検索が先に実行されることがあり実現困難)
'ElseIf ws.Cells(cnt_row + 2, 1).Value = "del" Then
'Set apiJson_db = getSearchData(ws_param)
'last_row = apiJson_db("values").Count
'new_id = getNewId(apiJson_db)
End If
NextLoop:
Next cnt_row
End Sub
データ更新のメインプロシージャから呼び出しているサブ関数(データ検索と重複する関数を除く)のソースです。ポイント事項は以下の通りです。
- getNewId(ID列の最大値取得)：データ検索結果の"values"内のID列(配列の1列目)の値を比較し、最大値を取得している
- getBody(データ更新用apiBody設定)：データ更新APIの仕様に合わせ、{ "values": ［［(更新データのカンマ区切りの値)］］ }の形になるよう整形している。ID列のみ数値のため、値を"で囲んでいない
'*****************************************
' getNewId：データ検索結果からID列の最大値を返す
'*****************************************
Private Function getNewId(apiJson As Object) As Long
Dim cnt_row As Long
Dim new_id As Long
new_id = 0
For cnt_row = 0 To apiJson("values").Count - 2 '検索結果ループ(タイトル行は除く)
If CLng(apiJson("values")(cnt_row + 2)(1)) > new_id Then
new_id = CLng(apiJson("values")(cnt_row + 2)(1))
End If
Next cnt_row
getNewId = new_id
End Function
'*****************************************
' getBody：ボディ格納(データ更新用)
' { "values": [[value(num), "value2(string)", "value3(string)"]] }
'*****************************************
Private Function getBody(ws As Worksheet, cnt_row As Long, new_id As Long) As String
Dim max_col As Long
Dim cnt_col As Long
Dim apiBody As String
'Renewシートの最大行列数を求める(Action列は除く)
max_col = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column - 1
apiBody = "{" & """" & "values" & """" & ":[["
For cnt_col = 0 To max_col - 1
If cnt_col > 0 Then
apiBody = apiBody & ","
End If
If cnt_col = 0 Then '数値:ID列
apiBody = apiBody & CStr(new_id)
Else '文字列:ID列以外
apiBody = apiBody & """" & "'" & ws.Cells(cnt_row + 2, cnt_col + 2).Value & """"
End If
Next
apiBody = apiBody & "]]}"
'Bodyの値を返す
getBody = apiBody
End Function
おわりに(実現のしやすさ比較)
以前の記事で似たようなことをやっていますので、実現のしやすさを比較してみました。この表ではSharePointリストの方が良さそうに見えますが、データ量や使いやすさの観点でどちらが良いかは使用者に依存すると考えます。
| データソース | ADO | API |
|---|---|---|
| SharePointリスト | ◎ (とても簡単) | ○ (API初期設定が面倒だが、VBAは簡単) |
| SharePoint上のExcel(テーブル未使用) | △ (データ削除系はADOでは機能しない。セル範囲による操作なら問題ないが、同期が必要かつ実装が煩雑) | × (API初期設定が面倒な上、セル範囲による操作が煩雑。データ削除(行削除)は再検索時に問題が発生するため、削除フラグを立てる形でないと厳しい) |
また、今回はデータソースのExcelをテーブルにしない形でAPIを扱いましたが、テーブルにした形でのAPIの扱いもあります（公式記事）。難易度は今回とほぼ同程度です。次回の記事で紹介します。
当ブログ内の連載記事
当ブログ内の関連記事
