VBAからGraph APIでExcel Onlineを読み書きしてみた - 実装編
前回のエントリーにて、VBAからMicrosoft Graph APIのOAuth2.0認証に於いて、Authenticate Codeの取得までを実装しました。PuppeteerでChromeを操縦しての認証用に専用のexeを用意して対応することで、IE11の消えたWindows11でも使えると思います。
今回は、このcodeからAccess Token取得、Tokenリフレッシュ、そしてExcel Onlineの読み書きを実装してみたいと思います。
リンク
今回使用するファイルやAPI等
- Graph APIで読み書きサンプル – Excelファイル
- サンプルの読み書き用Excelファイル
- OneDrive Business
- Excel Online
- Microsoft Graph API
- Graph API認証用のEXE
- VBA-JSON
※Google WorkspaceやBoxのような外部サービス上でExcel Onlineは起動しますが、Graph APIからはアクセス出来ないので、これらのファイルはAPIから操作は出来ません。OneDriveおよびSharePoint Onilne上のExcelファイルに対してだけ操作できるので、注意が必要です。
新方式が登場しました
IE11の廃止に伴い、SeleniumやNode.jsやらといった手段を使わず、またPuppeteerと同様の手法（CDPを叩く）でVBAとEdge/ChromeのみでOAuth2.0認証する手段が登場しました。スクレイピングも可能になっています。以下のエントリーを参考にしてみてください。この手法は最も制限が無く、もっともすぐれた選択肢になると思います。
Tokenを取得するコード
Access Tokenを取得する
前回ラストで取得したAuthenticate CodeがAccess Token引換券みたいなものなので、これを使ってAccess Token, Refresh_Token, Expire_inといった値を取得し、setting.iniに書き出す処理を実装します。実務ではAccess Tokenなどは暗号化してから保存する必要があります。今回は便宜上単純に書き出しているだけなので流出等しないよう厳重な管理が必要です。
Access Tokenの取得等ではWinHttpを利用しているため、企業内で使う場合はプロキシー設定が必要なケースがあります。その場合はオプションでプロキシURLの指定が必要です。
'OAuth認証用
Public Const tenant As String = "ここにテナントIDを入れる"
Public Const client_id As String = "ここにクライアントIDを入れる"
Public Const client_secret As String = "ここにクライアントシークレットを入れる"
Public Const redirecturl As String = "ここにリダイレクトURLを入れる"
Public Const oauthurl As String = "https://login.microsoftonline.com/"
Public Const refurl As String = "https://login.microsoftonline.com/common/oauth2/v2.0/token"
Public Const endpoint As String = "https://graph.microsoft.com/v1.0/"
Public Const scope As String = "User.Read%20offline_access%20User.ReadBasic.All%20Files.Read%20Files.ReadWrite"
'ファイルパス
Public Const excelpath As String = "saku/タスクマン.xlsx:"
'プロキシー設定
Public Const proxyuri As String = "ここにプロキシURLとポート番号を入れる" 'http://hoge.com:8080
'Access_Token他を取得するコード
Private Function GetAccessToken(ByVal auth_code As String) As Boolean
Dim access_token As String
Dim Json As String
Dim dat As Variant
Dim jsonstr As Object
'JSONをパースする用の変数
Dim doc, jsn
'HTMLDocumentを取得
Set doc = CreateObject("HtmlFile")
'scriptタグを追加
doc.Write "<script>document.JsonParse=function (s) {return eval('(' + s + ')');}</script>"
'TokenURLを構築する（Commonじゃなくtenantを使う）
Dim tokenurl As String
tokenurl = oauthurl & tenant & "/oauth2/v2.0/token"
'Access_Token取得用POST文字列の組み立て
dat = "code=" & auth_code & "&" & _
"client_id=" & client_id & "&" & _
"client_secret=" & client_secret & "&" & _
"redirect_uri=" & redirecturl & "&" & _
"grant_type=authorization_code&" & _
"scope=" & scope
'POST通信でAccess Token等をリクエスト
With CreateObject("WinHttp.WinHttpRequest.5.1")
.Open "POST", tokenurl, False
.setProxy 2, proxyuri
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded;charset=UTF-8"
.send dat
If .Status = 200 Then
'返ってきたJSON文字列を取得
Json = .ResponseText
If Len(Trim(Json)) > 0 Then
'JSON文字列より各種値を取得・保存
'パース関数でJSONオブジェクトを取得
Set jsn = doc.JsonParse(Json)
'Token情報をiniファイルに書き込み
IniWrite "USER", "access_token", jsn.access_token
IniWrite "USER", "refresh_token", jsn.refresh_token
IniWrite "USER", "expire_in", jsn.expires_in
IniWrite "USER", "getdate", Now()
IniWrite "USER", "expiredate", DateAdd("s", jsn.expires_in, Now())
'結果を返す
GetAccessToken = True
Else
'結果を返す
GetAccessToken = False
End If
Else
'結果を返す
GetAccessToken = False
End If
End With
End Function
- token取得用のURLはテナント毎に異なり通常企業で使用する場合はcommonは使えないので、コード内で組み立てています。
- POSTで投げるオプションは変数datに格納しています。ここでclient_secretと前回取得したauth_codeを指定しています。
- プロキシーを使っていない場合は、setProxyの行は不要なのでコメントアウトしておきます。
- JSONデータが返ってくるので、パースして、setting.iniファイルに書き込みをしています。Excelファイルと同じ場所に作成されています。
- この時、expireチェックの為のexpireする日付も生成して書き出ししています。
図：無事に取得出来ました
Token期限切れをチェックする
Graph APIのTokenはおよそ1時間で期限が切れます。故にAPIを叩く場合にはまず、期限切れをチェックし切れているもしくは切れそうな場合は、refresh_tokenを使って新しいTokenを取得するようにしています。しかし、あまりにもギリギリの場合は実行中にtoken期限切れを迎える可能性もあるため、自分の場合は残り30分を切っていたら更新するようにしています。
そのToken期限切れの確認をする為の関数を実装します。
'Access Tokenが認証切れかどうかをチェックする
Public Function checkExpireToken() As Boolean
'iniファイルからexpiredateを取得して比較
Dim checkflg As Boolean
Dim expireday As Variant
Dim expdate As Variant
expdate = IniRead("USER", "expiredate", "")
'expireのチェック
expireday = DateDiff("n", Now(), expdate)
'Access Tokenがexpireしているかどうかをチェック(30分以下)
If expireday <= 30 Then
'expireする日付まで30分以下の場合
checkflg = False
Else
'Access Tokenはまだ生きてるので問題ナシ
checkflg = True
End If
'フラグを返す
checkExpireToken = checkflg
End Function
- iniファイルに書き込んだexpiredateの値と現在の時刻を比較しています
- OKならばtrueを返してそのままAPIを実行させ、falseならば次のTokenリフレッシュのコードを実行させるようにします。
Tokenリフレッシュ
Tokenチェック用関数が出来上がったので、次にexpireしていた時用にTokenをリフレッシュする関数を作ります。しかし、殆どの構文がAccess Tokenを取得するコードと同じであるので、GetAccessToken関数にflgという引数を追加して、改造する事にしました。flgが0の場合は新規のAccess Tokenを取得とし、0以外ならばrefresh tokenでAccess Tokenを取得するように条件分岐しています。
'Access_Token他を取得するコード
Private Function GetAccessToken(ByVal auth_code As String, flg As Integer) As Boolean
Dim access_token As String
Dim Json As String
Dim dat As Variant
Dim jsonstr As Object
'JSONをパースする用の変数
Dim doc, jsn
'HTMLDocumentを取得
Set doc = CreateObject("HtmlFile")
'scriptタグを追加
doc.Write "<script>document.JsonParse=function (s) {return eval('(' + s + ')');}</script>"
'Access_Token取得用POST文字列の組み立て
Dim requrl As String
If flg = 0 Then
'新規にAccess Tokenを取得する
dat = "code=" & auth_code & "&" & _
"client_id=" & client_id & "&" & _
"client_secret=" & client_secret & "&" & _
"redirect_uri=" & redirecturl & "&" & _
"grant_type=authorization_code&" & _
"scope=" & scope
'リクエストURLを構築
requrl = oauthurl & tenant & "/oauth2/v2.0/token"
Else
'refresh tokenを使って再取得する
Dim reftoken As Variant
reftoken = IniRead("USER", "refresh_token", "")
dat = "client_id=" & client_id & "&" & _
"scope=" & scope & "&" & _
"refresh_token=" & reftoken & "&" & _
"redirect_uri=" & redirecturl & "&" & _
"grant_type=refresh_token&" & _
"client_secret=" & client_secret
'リクエストURLを構築
requrl = refurl
End If
'POST通信でAccess Token等をリクエスト
With CreateObject("WinHttp.WinHttpRequest.5.1")
.Open "POST", requrl, False
.setProxy 2, proxyuri
.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded;charset=UTF-8"
.send dat
If .Status = 200 Then
'返ってきたJSON文字列を取得
Json = .ResponseText
If Len(Trim(Json)) > 0 Then
'JSON文字列より各種値を取得・保存
'パース関数でJSONオブジェクトを取得
Set jsn = doc.JsonParse(Json)
'Token情報をiniファイルに書き込み
IniWrite "USER", "access_token", jsn.access_token
IniWrite "USER", "refresh_token", jsn.refresh_token
IniWrite "USER", "expire_in", jsn.expires_in
IniWrite "USER", "getdate", Now()
IniWrite "USER", "expiredate", DateAdd("s", jsn.expires_in, Now())
'結果を返す
GetAccessToken = True
Else
'結果を返す
GetAccessToken = False
End If
Else
'結果を返す
GetAccessToken = False
End If
End With
End Function
- iniファイルからrefresh_tokenを取得して利用します
- datの中身がcodeではなくrefresh_tokenとし、grant_typeもrefresh_tokenとする点が違う点です。
- あとは新しいAccess Token他を取得し直して、同じ用にiniファイルに書き戻すだけ
Excel Onlineを読み書きする
Access Token周りの装備が終わったのでいよいよExcel Onlineの操作をするのですが、Googleスプレッドシートのように簡単ではありません。通常はExcel Online上のファイルに付与されてるIDを使ってREST APIで叩くのですが、表向きこのIDはどこにも表示されておらず、これもDrive APIを利用してでないと確認出来ないのです。しかし、Googleスプレッドシートと違って、Drive上のファイルのパスを利用可能なので、これを利用して操作する事になります。
OneDrive上にファイルを作成しておく
ファイルを共有する
OneDrive上のExcelに対して読み書きをすることになるので、「編集権限」を付けた状態で、アクセスする人のアカウントを共有にて追加する必要があります（でなければ相手から見えない）。ちょっとBoxやGoogle Driveからしたら共有権限の付与がわかりにくいので注意。
- Excel Onlineの対象のファイルの右上にある「アクセス許可の管理」をクリックする
- 直接アクセスのプラスをクリックする
- 相手のMicrosoft365アカウントのメアドを入力する
- 編集権限か？閲覧権限か選択する
- 通知が相手に飛びアクセス可能になる
図：かなりわかりにくい権限付与方法
ファイルの配置とURLの取得
今回は１個のExcelファイル（タスクマン.xlsx）を用意し、taskmanというシート１個とテーブル１個（テーブル1という名前）で用意しました。場所はOneDriveのルート直下に配置している状態です。これをsakuというフォルダを作ってその中に移動して、そのファイルに対して操作を行います。xlsxファイルはOKですが、xlsファイルは未対応です。
このファイルへGraph APIでアクセスするには以下の２パターンになります。
- https://graph.microsoft.com/v1.0/me/drive/root:/saku/タスクマン.xlsx:/workbook/ にてアクセス（ファイルのパスで指定）。ファイルの最後にコロンがつく点に注意
- ファイルIDを調べて、https://graph.microsoft.com/v1.0/me/drive/items/ここにファイルID/workbook/ にてアクセス（但しこの場合自分だけしかアクセス出来ない）
- 他人にもアクセスしてもらうようにするには、以下のようなURL構成にする
//他人からもアクセスできるURL https://graph.microsoft.com/v1.0/users/オーナーのUID/drive/items/ここにファイルID/workbook/
オーナーのUIDはMicrosoft365上のファイルオーナーのUIDで、Graph Explorerにて「https://graph.microsoft.com/v1.0/me」を実行すると、自分のUIDが取れるので、自分がオーナーならばレスポンスにある「id」の項目がソレになります。
ちなみにファイルIDの調べ方ですが、これもAPIで調べられますが、Graph Explorerからであれば、一例として
- https://graph.microsoft.com/v1.0/search/query を POSTでリクエスト
- 要求本文のqueryStringにファイルの名前（今回はsakusakupanda.xlsxで検索）。以下がその内容になります。
{ "requests": [ { "entityTypes": [ "driveItem" ], "query": { "queryString": "zaseki.xlsx" } } ] } - 要求ヘッダに「content-type」の「application/json」を追加しておく
- クエリを実行
- 成功すると、OK 200が返ってくる。
- 中に情報が入っており、ファイル名ほか目的のファイルIDも入ってる。
図：用意したファイルの様子
図：ファイルIDを調べてみた
テーブルにレコードを追加
予めテーブルにしてあるのは、Graph APIからデータを追加したり、取得がとても楽だからです。まずは、テーブルに対して１行レコードを追加してみます。
'レコードを追加する
Public Function insertRecord()
'エンドポイントURLを構築
Dim requrl As String
requrl = endpoint & "me/drive/root:/" & excelpath & "/workbook/tables('テーブル1')/rows"
'Access Tokenの取得と失効チェック
Dim tokenstatus As Boolean
tokenstatus = checkExpireToken() 'Access Tokenの取得と失効チェック
'Tokenの状況に応じて処理を分岐
Select Case tokenstatus
Case True
'無事にTokenは生きてるので何もしない
Case False
'refresh token使って新しいTokenを取得
ret = GetAccessToken(authcode, -1)
'取得結果を判定
If ret = True Then
'無事に取得できているのでスルーする
Else
'取得失敗
MsgBox "Access Tokenの取得に失敗しました。"
Exit Function
End If
End Select
'Access Tokenを取得する
Dim access_token As String
access_token = IniRead("USER", "access_token", "")
'行追加用のJSON構築
Dim jsondata As String
jsondata = "{"
jsondata = jsondata & Chr(34) & "values" & Chr(34) & ":" & "[["
'レコード部分
Dim rec As String
rec = Chr(34) & "1" & Chr(34) & "," & _
Chr(34) & "鉢植え" & Chr(34) & "," & _
Chr(34) & "地獄太郎" & Chr(34) & "," & _
Chr(34) & "果物" & Chr(34) & "," & _
Chr(34) & "2021-10-09" & Chr(34) & "," & _
Chr(34) & "2021-11-30" & Chr(34) & "," & _
Chr(34) & "未実施" & Chr(34)
jsondata = jsondata & rec
jsondata = jsondata & "]],"
jsondata = jsondata & Chr(34) & "index" & Chr(34) & ":" & "null"
jsondata = jsondata & "}"
'リクエストを実行
With CreateObject("WinHttp.WinHttpRequest.5.1")
.Open "POST", requrl, False
.setProxy 2, proxyuri
.SetRequestHeader "Content-Type", "application/json"
.SetRequestHeader "Authorization", "Bearer " & access_token
.send jsondata
'返ってきた値をもとにデータを処理
Select Case .Status
Case 201
'レスポンスヘッダを取得
Debug.Print .GetAllResponseHeaders()
MsgBox "レコードを追加しました"
Case Else
MsgBox "レコードの追加に失敗しました"
End Select
End With
End Function
- checkExpireTokenにてまずは期限切れチェック
- リクエストするURLはhttps://graph.microsoft.com/v1.0/me/drive/root:/saku/タスクマン.xlsx:/workbook/tables('テーブル1')/rowsで構築
- 期限切れだった場合には、GetAccessToken(authcode, -1)にて、トークンリフレッシュを実行
- Access Tokenを取得したら、送信するレコードをJSONの形式で構築する。レコードの列数と合わせないとエラーになります。
//構築事例 {"values":[["2","収穫","晴天太郎","秋野菜","2021-11-01","2021-12-01","収穫中"]],"index":null} - 構築したJSONとともにリクエストを投げる。201が返ってきたら成功です。
- JSONの構築部分が今回の関数では非常に癖が強いので、Dictionaryなどを使った手法を使ったほうが楽になれるかもしれません。
- テーブル名で指定してるのでいちいちシート名を気にすることなく流し込めます
Excel Online側は画面をリロードするとデータが確認出来ます。ちょっと反応がモッサリしてる感じがする。
図：リクエストはこんな感じで行う
図：データが追加された様子
テーブルデータを取得する
Excel Onlineのテーブルデータを取得し、自身のExcelファイルに書き出す処理を実装します。やや取り出し画面なJSON形式ではありますが、VBA-JSONを利用する事で割とスムーズにレコードデータを取れます。
'テーブルデータを取得する
Public Function getTableRecord()
'エンドポイントURLを構築
Dim requrl As String
requrl = endpoint & "me/drive/root:/" & excelpath & "/workbook/tables('テーブル1')/rows"
'Access Tokenの取得と失効チェック
Dim tokenstatus As Boolean
tokenstatus = checkExpireToken() 'Access Tokenの取得と失効チェック
'Tokenの状況に応じて処理を分岐
Select Case tokenstatus
Case True
'無事にTokenは生きてるので何もしない
Case False
'refresh token使って新しいTokenを取得
ret = GetAccessToken(authcode, -1)
'取得結果を判定
If ret = True Then
'無事に取得できているのでスルーする
Else
'取得失敗
MsgBox "Access Tokenの取得に失敗しました。"
Exit Function
End If
End Select
'JSON受信用
Dim Json As Object
Dim doc, jsn
'HTMLDocumentを取得
Set doc = CreateObject("HtmlFile")
'scriptタグを追加
doc.Write "<script>document.JsonParse=function (s) {return eval('(' + s + ')');}</script>"
'Access Tokenを取得する
Dim access_token As String
access_token = IniRead("USER", "access_token", "")
'リクエストを実行
Dim reccnt As Integer
Dim counter As Integer
Dim tempcnt As Integer
With CreateObject("WinHttp.WinHttpRequest.5.1")
.Open "GET", requrl, False
'.setProxy 2, proxyuri
.SetRequestHeader "Authorization", "Bearer " & access_token
.send
'返ってきた値をもとにデータを処理
Select Case .Status
Case 200
'JSON文字列より各種値を取得・保存
'パース関数でJSONオブジェクトを取得
Set Json = JsonConverter.ParseJson(.ResponseText)
Debug.Print .ResponseText
'レコード数を調べる
reccnt = Json("value").Count - 1
'配列を用意する
Dim recarr() As Variant
ReDim recarr(reccnt, 7)
counter = 0
'インデックス用
Dim indexman As Integer
'JSONの中でvalueの中身を取得する
For Each records In Json("value")
'インデックスを取得する
indexman = records("index")
For Each recs In records("values")(1) '二次元配列だが１レコードしか入っていない為
'配列に値を追加
recarr(counter, tempcnt) = recs
'tempcntを加算
tempcnt = tempcnt + 1
Next
'インデックスを加える
recarr(counter, 7) = indexman
'カウンタを加算
counter = counter + 1
'tempcntを初期化
tempcnt = 0
Next
'配列をシートに書き出し
ThisWorkbook.Worksheets("Sheet1").Range("A2:H" & Json("value").Count + 1) = recarr
'終了メッセージ
MsgBox "データの取得が完了しました。"
Case Else
MsgBox "レコードの取得に失敗しました"
End Select
End With
End Function
- 前半はレコード追加とほぼ同じように、Tokenの期限切れと再取得のコードです
- リクエストURLについてもレコード挿入と同じURLですが、メソッドがPOSTではなくGETである点に注意
- 受信したレコードデータはJsonConverter.ParseJsonでパースします
- valueの中に１レコードずつvaluesという二次元配列（でも１レコードだけしか入っていない）を取り出す事になるので、For Eachで回して取り出します
- レコード数をJson("value").Countで調べて、VBA側で空の二次元配列を用意しておきます。
- For Eachでレコードデータをrecarrという配列に順次書き込みをし、一発でシートに書き出しをしています。
- indexの値はテーブル上に於ける行番号であり、0から始まります。行を更新する場合などに必要になります）
図：こんな感じでデータが入っている
テーブルデータの行を更新する
Graph APIを使って特定の行のデータを更新することが出来ますが、公式ドキュメントの通りに構築すると、400エラーで動作しません。こちらのサイトでも報告されているのですが、公式ドキュメントが更新されておらず、非常にハマるポイントです。また、更新をする為には、Excel Online上のレコードに自動で割り振られてるindexの値（行番号）が必要となりますので、受信するローカルのExcelファイル側でそのIndexの値を追加して追記しておく必要もあります（Excel Online側はRow番号は特に追加する必要はないですがしておいたほうが、便利ではあります）
エンドポイントの構築
リクエスト時に使うエンドポイントですが、変則的でここが公式の通りに構築すると動きません。以下のように構築します。
https://graph.microsoft.com/v1.0/me/drive/root:/saku/タスクマン.xlsx:/workbook/tables/テーブル名/rows/itemAt(index=1)/range
rowsの後にitemAt(index=1)/rangeをつなげることで動きます。このindex=1の値が行番号になります。テーブルの2行目を意味し、セル番地的にはA3からの位置になるので注意（テーブル1行目の行番号はindex=0、つまりA2からとなるので要注意）
これで特定の行を更新することが可能になります。
※但し計測してみたら、この値が他者にまで反映するのに2分ものタイムラグがある。よって自分は掛けても他者からみた時に反映していない事があります。解決策模索中・・・（Googleスプレッドシートだとこういう事がないのですが）
リクエストの内容
送信するリクエストの内容は以下の通り。これを構築して、送信します。indexには同じく行番号を入れておきます。values以下が値になりますが、JSONで構築する点に注意。
{
"index": 2,
"values": [
[
"1",
"鉢植え",
"地獄太郎",
"果物",
"2021-10-09",
"2021-11-30",
"未実施"
]
]
}
ソースコード
'テーブルのレコードを更新する
Public Function setTableUpdate()
'エンドポイントURLを構築
Dim requrl As String
requrl = endpoint & "me/drive/root:/" & excelpath & "/workbook/tables/テーブル名/rows/itemAt(index=1)/range"
'Access Tokenの取得と失効チェック
Dim tokenstatus As Boolean
tokenstatus = checkExpireToken() 'Access Tokenの取得と失効チェック
'Tokenの状況に応じて処理を分岐
Select Case tokenstatus
Case True
'無事にTokenは生きてるので何もしない
Case False
'refresh token使って新しいTokenを取得
ret = GetAccessToken(authcode, -1)
'取得結果を判定
If ret = True Then
'無事に取得できているのでスルーする
Else
'取得失敗
MsgBox "Access Tokenの取得に失敗しました。"
Exit Function
End If
End Select
'Access Tokenを取得する
Dim access_token As String
access_token = IniRead("USER", "access_token", "")
'行追加用のJSON構築
Dim jsondata As String
jsondata = "{"
jsondata = jsondata & Chr(34) & "index" & Chr(34) & ":" & indexman & ","
jsondata = jsondata & Chr(34) & "values" & Chr(34) & ":" & "[["
'レコード部分
Dim rec As String
rec = Chr(34) & "1" & Chr(34) & "," & _
Chr(34) & "kabayaki" & Chr(34) & "," & _
Chr(34) & "地獄太郎" & Chr(34) & "," & _
Chr(34) & "果物" & Chr(34) & "," & _
Chr(34) & "2021-10-09" & Chr(34) & "," & _
Chr(34) & "2021-11-30" & Chr(34) & "," & _
Chr(34) & "未実施" & Chr(34)
jsondata = jsondata & rec
jsondata = jsondata & "]]}"
Debug.Print jsondata
'リクエストを実行
With CreateObject("WinHttp.WinHttpRequest.5.1")
.Open "PATCH", requrl, False
'.setProxy 2, proxyuri
.SetRequestHeader "Content-Type", "application/json"
.SetRequestHeader "Authorization", "Bearer " & access_token
.send jsondata
'返ってきた値をもとにデータを処理
Select Case .Status
Case 200
'レスポンスヘッダを取得
Debug.Print .GetAllResponseHeaders()
MsgBox "レコードを更新しました"
Case Else
MsgBox .Status & "エラー。レコードの更新に失敗しました"
End Select
End With
End Function
- 基本的にはレコードの追加とほぼ同じですが、リクエストメソッドはPATCHになるので注意
- エンドポイントURLの構築も注意が必要です。
図：IDが2のレコードが更新された様子
永続セッションを作成する
前項までの手法で、テーブルデータの作成およびレコードの更新は出来るのですが、このままでは「他者に情報が反映するまで2分以上のタイムラグ」が発生する為、具合が悪いです。そのため、書き込みをしてもすぐにデータが反映されないので、この問題を解消するには永続セッションというものを作成し、session-idを取得後に、データの取得やレコードデータの更新時に、リクエストヘッダに取得したsession-idを加えることで、リアルタイムに読み書きが可能になります。
よって、このテクニックは実務で利用する場合は、Excel Onlineを読み書きするアプリとしては必須のテクニックとなります。
セッション作成のコード
'セッション情報を作成する
Public Function createSession() As String
'セッション情報用
Dim sessionid As String
'エンドポイントURLを構築
Dim requrl As String
requrl = endpoint & "me/drive/root:/" & excelpath & "/workbook/createSession"
'Access Tokenの取得と失効チェック
Dim tokenstatus As Boolean
tokenstatus = checkExpireToken() 'Access Tokenの取得と失効チェック
'Tokenの状況に応じて処理を分岐
Select Case tokenstatus
Case True
'無事にTokenは生きてるので何もしない
Case False
'refresh token使って新しいTokenを取得
ret = GetAccessToken(authcode, -1)
'取得結果を判定
If ret = True Then
'無事に取得できているのでスルーする
Else
'取得失敗
MsgBox "Access Tokenの取得に失敗しました。"
Exit Function
End If
End Select
'Access Tokenを取得する
Dim access_token As String
access_token = IniRead("USER", "access_token", "")
'リクエストボディを作成する
Dim jsondata As String
jsondata = "{"
jsondata = jsondata & Chr(34) & "persistChanges" & Chr(34) & ":" & Chr(34) & "true" & Chr(34) & "}"
'JSON受信用
Dim Json As Object
Dim doc, jsn
'HTMLDocumentを取得
Set doc = CreateObject("HtmlFile")
'scriptタグを追加
doc.Write "<script>document.JsonParse=function (s) {return eval('(' + s + ')');}</script>"
'リクエストを実行
With CreateObject("WinHttp.WinHttpRequest.5.1")
.Open "POST", requrl, False
'.setProxy 2, proxyuri
.SetRequestHeader "Content-Type", "application/json"
.SetRequestHeader "Authorization", "Bearer " & access_token
.send jsondata
'返ってきた値をもとにデータを処理
Select Case .Status
Case 201
'レスポンスヘッダを取得
Debug.Print .GetAllResponseHeaders()
'JSON文字列より各種値を取得・保存
'パース関数でJSONオブジェクトを取得
Set Json = JsonConverter.ParseJson(.ResponseText)
'セッションIDを取り出す
sessionid = Json("id")
Debug.Print sessionid
'値を返す
createSession = sessionid
Case Else
MsgBox "レコードの追加に失敗しました"
End Select
End With
End Function
- persistChangesをfalseにすると非永続セッションとなってしまうので実験用で用いるものになり、反映もしません。
- セッションIDを取り出したら、呼び出し元に返します。
取得したセッションIDでリクエスト
テーブルデータの取得の事例をセッションIDを使ってリクエストするサンプルです。
'テーブルデータを取得する
Public Function getTableRecord()
'エンドポイントURLを構築
Dim requrl As String
requrl = endpoint & "me/drive/root:/" & excelpath & "/workbook/tables/テーブル名/rows"
'Access Tokenの取得と失効チェック
Dim tokenstatus As Boolean
tokenstatus = checkExpireToken() 'Access Tokenの取得と失効チェック
'Tokenの状況に応じて処理を分岐
Select Case tokenstatus
Case True
'無事にTokenは生きてるので何もしない
Case False
'refresh token使って新しいTokenを取得
ret = GetAccessToken(authcode, -1)
'取得結果を判定
If ret = True Then
'無事に取得できているのでスルーする
Else
'取得失敗
MsgBox "Access Tokenの取得に失敗しました。"
Exit Function
End If
End Select
'JSON受信用
Dim Json As Object
Dim doc, jsn
'HTMLDocumentを取得
Set doc = CreateObject("HtmlFile")
'scriptタグを追加
doc.Write "<script>document.JsonParse=function (s) {return eval('(' + s + ')');}</script>"
'Access Tokenを取得する
Dim access_token As String
access_token = IniRead("USER", "access_token", "")
'セッションIDを取得する
Dim sessionman As String
sessionman = createSession()
'リクエストを実行
Dim reccnt As Integer
Dim counter As Integer
Dim tempcnt As Integer
With CreateObject("WinHttp.WinHttpRequest.5.1")
.Open "GET", requrl, False
'.setProxy 2, proxyuri
.SetRequestHeader "Authorization", "Bearer " & access_token
.SetRequestHeader "workbook-session-id", sessionman
.send
'返ってきた値をもとにデータを処理
Debug.Print .Status
Select Case .Status
Case 200
'JSON文字列より各種値を取得・保存
'パース関数でJSONオブジェクトを取得
Set Json = JsonConverter.ParseJson(.ResponseText)
Debug.Print .ResponseText
'レコード数を調べる
reccnt = Json("value").Count - 1
'配列を用意する
Dim recarr() As Variant
ReDim recarr(reccnt, 7)
counter = 0
'インデックス用
Dim indexman As Integer
'JSONの中でvalueの中身を取得する
For Each records In Json("value")
'インデックスを取得する
indexman = records("index")
For Each recs In records("values")(1) '二次元配列だが１レコードしか入っていない為
'配列に値を追加
recarr(counter, tempcnt) = recs
'tempcntを加算
tempcnt = tempcnt + 1
Next
'インデックスを加える
recarr(counter, 7) = indexman
'カウンタを加算
counter = counter + 1
'tempcntを初期化
tempcnt = 0
Next
'配列をシートに書き出し
ThisWorkbook.Worksheets("Sheet1").Range("A2:H" & Json("value").Count + 1) = recarr
'終了メッセージ
MsgBox "データの取得が完了しました。"
Case Else
MsgBox "レコードの取得に失敗しました"
End Select
End With
End Function
- createSessionを呼び出してセッションIDを取得させます。
- リクエストヘッダに「.SetRequestHeader "workbook-session-id", sessionman」を追加して、セッションIDにてリクエストを行う
関連リンク
- ユーザーの代わりにアクセスを取得
- 訳あってMicrosoft Graph API調べてみた
- Microsoft Graph での Excel の操作
- Microsoft Graph API - Getting files by file path - 404 Not Found
- ブックのリソースの種類
- DriveItem リソースを取得する
- VBAでparseしたJSONデータの要素を取得する方法
- VBAの連想配列のJSONの作成方法
- Update multiple rows in Excel table with MS Graph API
- Get List of Rows from Excel Table using Graph API
- Update tablerow - Microsoft
- Unable to get a TableRow by index as stated in the docs. A workaround is needed
- json - Microsoft GraphおよびExcel APIからの古いデータ
- Excel でセッションと永続化を管理する
- セッションと永続化
- 範囲の更新要求は200 OKを返しますが、Excelシートは更新しません
