2021年11月18日 / 最終更新日時 : 2021年11月19日 officeの杜 Microsoft365

VBAからGraph APIでExcel Onlineを読み書きしてみた – 実装編

前回のエントリーにて、VBAからMicrosoft Graph APIのOAuth2.0認証に於いて、Authenticate Codeの取得までを実装しました。PuppeteerでChromeを操縦しての認証用に専用のexeを用意して対応することで、IE11の消えたWindows11でも使えると思います。

今回は、このcodeからAccess Token取得、Tokenリフレッシュ、そしてExcel Onlineの読み書きを実装してみたいと思います。

1 今回使用するファイルやAPI等
2 Tokenを取得するコード
3 Excel Onlineを読み書きする
4 関連リンク

今回使用するファイルやAPI等

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

'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

'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

'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からデータを追加したり、取得がとても楽だからです。まずは、テーブルに対して１行レコードを追加してみます。

'レコードを追加する
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

'レコードを追加する

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の形式で構築する。レコードの列数と合わせないとエラーになります。

JavaScript

//構築事例 {"values":[["2","収穫","晴天太郎","秋野菜","2021-11-01","2021-12-01","収穫中"]],"index":null}

1
2

//構築事例
{"values":[["2","収穫","晴天太郎","秋野菜","2021-11-01","2021-12-01","収穫中"]],"index":null}
構築したJSONとともにリクエストを投げる。201が返ってきたら成功です。
JSONの構築部分が今回の関数では非常に癖が強いので、Dictionaryなどを使った手法を使ったほうが楽になれるかもしれません。
テーブル名で指定してるのでいちいちシート名を気にすることなく流し込めます

Excel Online側は画面をリロードするとデータが確認出来ます。ちょっと反応がモッサリしてる感じがする。

VBAで利用できる様々な配列処理

図：リクエストはこんな感じで行う

図：データが追加された様子

テーブルデータを取得する

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

    '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

'テーブルデータを取得する

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

'カウンタを加算

counter = counter + 1

'tempcntを初期化

tempcnt = 0

'配列をシートに書き出し

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という配列に順次書き込みをし、一発でシートに書き出しをしています。

図：こんな感じでデータが入っている

今回使用するファイルやAPI等

Tokenを取得するコード

Access Tokenを取得する

Token期限切れをチェックする

Tokenリフレッシュ

Excel Onlineを読み書きする

OneDrive上にファイルを作成しておく

テーブルにレコードを追加

テーブルデータを取得する

関連リンク

コメントを残す コメントをキャンセル

WordPressのスピードチューニングをしてみた

コメントを残すコメントをキャンセル