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ファイル
- OneDrive Business
- Excel Online
- Microsoft Graph API
- Graph API認証用のEXE
- VBA-JSON
※Google WorkspaceやBoxのような外部サービス上でExcel Onlineは起動しますが、Graph APIからはアクセス出来ないので、これらのファイルはAPIから操作は出来ません。OneDriveおよびSharePoint Onilne上のExcelファイルに対してだけ操作できるので、注意が必要です。
Tokenを取得するコード
Access Tokenを取得する
前回ラストで取得したAuthenticate CodeがAccess Token引換券みたいなものなので、これを使ってAccess Token, Refresh_Token, Expire_inといった値を取得し、setting.iniに書き出す処理を実装します。実務ではAccess Tokenなどは暗号化してから保存する必要があります。今回は便宜上単純に書き出しているだけなので流出等しないよう厳重な管理が必要です。
Access Tokenの取得等ではWinHttpを利用しているため、企業内で使う場合はプロキシー設定が必要なケースがあります。その場合はオプションでプロキシURLの指定が必要です。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 |
'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期限切れの確認をする為の関数を実装します。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 |
'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を取得するように条件分岐しています。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 |
'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上にファイルを作成しておく
今回は１個の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/ にてアクセス
ちなみにファイルIDの調べ方ですが、これもAPIで調べられますが、Graph Explorerからであれば、一例として
- https://graph.microsoft.com/v1.0/search/query を POSTでリクエスト
- 要求本文のqueryStringにファイルの名前（今回はsakusakupanda.xlsxで検索）
- クエリを実行
- 成功すると、OK 200が返ってくる。
- 中に情報が入っており、ファイル名ほか目的のファイルIDも入ってる。
図：用意したファイルの様子
図：ファイルIDを調べてみた
テーブルにレコードを追加
予めテーブルにしてあるのは、Graph APIからデータを追加したり、取得がとても楽だからです。まずは、テーブルに対して１行レコードを追加してみます。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 |
'レコードを追加する 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の形式で構築する。レコードの列数と合わせないとエラーになります。
12//構築事例{"values":[["2","収穫","晴天太郎","秋野菜","2021-11-01","2021-12-01","収穫中"]],"index":null} - 構築したJSONとともにリクエストを投げる。201が返ってきたら成功です。
- JSONの構築部分が今回の関数では非常に癖が強いので、Dictionaryなどを使った手法を使ったほうが楽になれるかもしれません。
- テーブル名で指定してるのでいちいちシート名を気にすることなく流し込めます
Excel Online側は画面をリロードするとデータが確認出来ます。ちょっと反応がモッサリしてる感じがする。
図：リクエストはこんな感じで行う
図：データが追加された様子
テーブルデータを取得する
Excel Onlineのテーブルデータを取得し、自身のExcelファイルに書き出す処理を実装します。やや取り出し画面なJSON形式ではありますが、VBA-JSONを利用する事で割とスムーズにレコードデータを取れます。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 |
'テーブルデータを取得する 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 '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) 'レコード数を調べる reccnt = Json("value").Count - 1 '配列を用意する Dim recarr() As Variant ReDim recarr(reccnt, 6) counter = 0 'JSONの中でvalueの中身を取得する For Each records In Json("value") For Each recs In records("values")(1) '二次元配列だが１レコードしか入っていない為 '配列に値を追加 recarr(counter, tempcnt) = recs 'tempcntを加算 tempcnt = tempcnt + 1 Next 'カウンタを加算 counter = counter + 1 'tempcntを初期化 tempcnt = 0 Next '配列をシートに書き出し ThisWorkbook.Worksheets("Sheet1").Range("A2:G" & Json("value").Count) = 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という配列に順次書き込みをし、一発でシートに書き出しをしています。
図：こんな感じでデータが入っている
