Office関連

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ページ

【まほうのルミティア】ルミティアジュエルの先行体験者募集中前のページ

2016年3月の人気記事次のページ

関連記事

  1. アイコン一覧

    Office 365アイコン(imageMso)一覧を作成するにあたって

    Office 2013のアイコン一覧を公開してから4年ほど経ち、その間…

  2. Office関連

    「IEを自在に操る Excel VBAプログラミング入門」レビュー

    ※ 下記レビューはあくまでも個人的な感想です。2013年9月2…

  3. Office関連

    [Office VBA]ADOでSharePointリストに接続する方法

    先日Twitterで @blacklist_ryu さんが下記ツイート…

  4. Office関連

    SmartArtからテキストを取得するPowerPointマクロ

    Twitterで@terrysaitoさんが下記のようなツイートをされ…

  5. Office関連

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

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

  6. Office関連

    指定したAccessファイルで「データベースの最適化/修復」を実行するVBAマクロ

    大分前の記事になりますが、開いているデータベースを最適化するマクロのコ…

コメント

  • コメント (0)

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

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

Time limit is exhausted. Please reload CAPTCHA.

※本ページはプロモーションが含まれています。

Translate

最近の記事

アーカイブ

PAGE TOP