Excel REST APIをVBAから呼び出す方法

ホーム
Office関連, Excel, Microsoft Graph, Office 365
Excel REST APIをVBAから呼び出す方法

Office関連

2016.03.31

Excel REST APIをVBAから呼び出す方法

「Microsoft GraphをVBAから呼び出してOneNoteのページ内容を取得する」記事で触れていた“Excel REST API”ですが、知らぬ間に使えるようになっていたみたいです。

それならばやることは一つ。
VBAから呼び出してみたいと思います。

下準備

APIを利用するために、Azure ADの設定やらクライアント IDの取得やらが必要になるのですが、作業手順は「Office 365 Unified APIをVBAから呼び出す」で書いていることとほぼ同じなので、ここでは割愛します。

アプリケーションの種類：ネイティブクライアントアプリケーション
リダイレクト URI：http://localhost/WBSample
他のアプリケーションに対するアクセス許可：Microsoft Graph
デリゲートされたアクセス許可：Have full access to user files

取得するWorkbook

今回は下図のように、OneDriveに置いてある「SampleBook.xlsx」の「SampleSheet」シート、セルB3の値を取得してみます。

MicrosoftGraph_ExcelRestAPI_VBA_01

MicrosoftGraph_ExcelRestAPI_VBA_02

VBAコード

さっそく書いたコードが下記になります。

authorization code取得
↓
access token取得
↓
OneDriveに保存されたファイルの中からSampleBook.xlsxのIDを取得
↓
Excel REST APIを呼び出してセルの値を取得

処理としては上記のような流れになります。

Option Explicit

Public Sub SampleExcelRestAPI()
'サンプル - Microsoft Graph(Excel REST API)呼び出し
'※ ScriptControlを使っているため、32ビット環境のみ対応
'※ リダイレクト URIをlocalhostにしている場合は、ローカルサーバー(XAMPP他)の起動が必要な場合があります。
  Dim url_auth As String
  Dim url_token As String
  Dim url_api As String
  Dim q As String
  Dim code As String
  Dim js As String
  Dim access_token As String
  Dim workbook_id As String
  Dim dat As Variant
  Dim ary As Variant, ary2 As Variant
  Dim req As Object
  Dim sc As Object
  Dim items As Object
  Dim item As Object
  Dim i As Long
  Dim value, values, id, name 'JSONパース用ダミー
  Const READYSTATE_COMPLETE = 4
  
  '***********************************
  '※ 要変更
  '***********************************
  Const client_id As String = "(クライアント ID)" 'クライアント ID
  Const redirect_uri As String = "http://localhost/WBSample" 'リダイレクト URI
  Const workbook_name As String = "SampleBook.xlsx" '取得するWorkbook名
  Const worksheet_name As String = "SampleSheet" '取得するWorksheet名
  '***********************************
  
  'authorization code取得
  code = "" '初期化
  url_auth = "https://login.microsoftonline.com/common/oauth2/authorize?response_type=code" & _
             "&redirect_uri=" & EncodeURL(redirect_uri) & _
             "&client_id=" & client_id & _
             "&resource=" & EncodeURL("https://graph.microsoft.com/")
  With CreateObject("InternetExplorer.Application")
    .Visible = True
    .AddressBar = False
    .MenuBar = False
    .StatusBar = False
    .Toolbar = False
    .Width = 600
    .Height = 480
    .Navigate url_auth
    While .ReadyState <> READYSTATE_COMPLETE Or _
          .Busy = True Or _
          (StrComp(Left(.LocationURL, Len(redirect_uri)), redirect_uri) <> 0)
      DoEvents
    Wend
    q = .document.parentWindow.Location.Search
    q = Mid(q, 2) '"?"削除
    ary = Split(q, "&")
    For i = LBound(ary) To UBound(ary)
      ary2 = Split(ary(i), "=")
      If LCase(ary2(0)) = "code" Then
        code = ary2(1)
        Exit For
      End If
    Next
  End With
  If Len(Trim(code)) < 1 Then Exit Sub
  
  'access token取得
  js = "": access_token = "" '初期化
  url_token = "https://login.microsoftonline.com/common/oauth2/token"
  dat = "grant_type=authorization_code" & _
        "&code=" & code & _
        "&client_id=" & client_id & _
        "&redirect_uri=" & EncodeURL(redirect_uri)
  Set req = CreateObject("WinHttp.WinHttpRequest.5.1")
  With req
    .Open "POST", url_token, False
    .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    .send dat
    Select Case .Status
      Case 200: js = .responseText
    End Select
  End With
  If Len(Trim(js)) < 1 Then Exit Sub
  js = "(" & js & ")"
  Set sc = CreateObject("ScriptControl")
  With sc
    .Language = "JScript"
    access_token = .CodeObject.eval(js).access_token
  End With
  If Len(Trim(access_token)) < 1 Then Exit Sub
  
  'OneDriveのファイル列挙
  js = "": workbook_id = "" '初期化
  url_api = "https://graph.microsoft.com/beta/me/drive/root/children"
  With req
    .Open "GET", url_api, False
    .setRequestHeader "Authorization", "Bearer " & access_token
    .send
    Select Case .Status
      Case 200: js = .responseText
      Case Else: Debug.Print .responseText
    End Select
  End With
  If Len(Trim(js)) < 1 Then Exit Sub
  js = "(" & js & ")"
  'Workbook ID取得
  With sc
    .Language = "JScript"
    Set items = .CodeObject.eval(js).value
    For Each item In items
      If item.name = workbook_name Then
        workbook_id = item.id
        Exit For
      End If
    Next
  End With
  If Len(Trim(workbook_id)) < 1 Then Exit Sub
  
  '指定したWorksheetのセルB3の値を取得
  js = "" '初期化
  url_api = "https://graph.microsoft.com/beta/me/drive/items/" & workbook_id & _
            "/Workbook/Worksheets/" & worksheet_name & "/Range(address='B3')"
  With req
    .Open "GET", url_api, False
    .setRequestHeader "Authorization", "Bearer " & access_token
    .send
    Select Case .Status
      Case 200: js = .responseText
      Case Else: Debug.Print .responseText
    End Select
  End With
  If Len(Trim(js)) < 1 Then Exit Sub
  Debug.Print js 'レスポンス(JSON)確認用
  js = "(" & js & ")"
  With sc
    .Language = "JScript"
    MsgBox "Workbook:" & workbook_name & vbNewLine & _
           "Worksheet:" & worksheet_name & vbNewLine & _
           "セルB3:" & .CodeObject.eval(js).values, vbInformation + vbSystemModal
  End With
  
  MsgBox "処理が終了しました。", vbInformation + vbSystemModal
End Sub

Private Function EncodeURL(ByVal Target As String) As String
'URLエンコード
  With CreateObject("ScriptControl")
    .Language = "JScript"
    EncodeURL = .CodeObject.encodeURIComponent(Target)
  End With
End Function

問題なくAPIの呼び出しが行われると、下図のようにセルの値がメッセージボックスで表示されます。

MicrosoftGraph_ExcelRestAPI_VBA_03

ちなみに、セルを取得(Get Range)した際には下記のようなレスポンスが返ってきます。

{
    "@odata.context": "https://graph.microsoft.com/beta/$metadata#range",
    "@odata.type": "#microsoft.graph.range",
    "@odata.id": "/users('********-****-****-****-************')/drive/items('**********************************')/workbook/worksheets('{00000000-0001-0000-0000-000000000000}')/range(address='B3')",
    "address": "SampleSheet!B3",
    "addressLocal": "SampleSheet!B3",
    "cellCount": 1,
    "columnCount": 1,
    "columnHidden": false,
    "columnIndex": 1,
    "formulas": [
        ["Test"]
    ],
    "formulasLocal": [
        ["Test"]
    ],
    "formulasR1C1": [
        ["Test"]
    ],
    "hidden": false,
    "numberFormat": [
        ["General"]
    ],
    "rowCount": 1,
    "rowHidden": false,
    "rowIndex": 2,
    "text": [
        ["Test"]
    ],
    "values": [
        ["Test"]
    ],
    "valueTypes": [
        ["String"]
    ]
}

私が試した限りでは、まだプレビュー版であるためか上手く結果が返ってこないメソッドもありましたが、出番が多そうなAPIなので今後に期待したいと思います。