Excel

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

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

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

下準備

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

  1. アプリケーションの種類:ネイティブ クライアント アプリケーション
  2. リダイレクト URI:http://localhost/WBSample
  3. 他のアプリケーションに対するアクセス許可:Microsoft Graph
  4. デリゲートされたアクセス許可: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なので今後に期待したいと思います。

参考Webページ

関連記事

  1. Office関連

    Word 2013の「個人用テンプレート」はどこ?

    Word 2010では、から「個人用テンプレート」(カスタム テンプレ…

  2. Excel

    [Office 2013]コントロール日英比較表

    日本語版と英語版のOffice 2013でコントロール(コマンド)名や…

  3. Office アドイン

    [Office用アプリ]開発入門の記事を書かせていただきました。

    日経ソフトウエア 2014年3月号から連載の「Office用アプリ開発…

  4. Office アドイン

    [Office用アプリ]アプリ開発コンテスト・受賞者発表

    以前書いた記事でお知らせしていた「Apps for Office アプ…

  5. Excel

    Faviconをダウンロードするマクロ

    WebサイトからFaviconを抜き出すAPIがあったので早速使ってみ…

コメント

  • コメント (0)

  • トラックバックは利用できません。

  1. この記事へのコメントはありません。

Time limit is exhausted. Please reload CAPTCHA.

最近の記事

アーカイブ

RapidSSL_SEAL-90x50
PAGE TOP