Microsoft GraphをVBAから呼び出してOneNoteのページ内容を取得する

ホーム
Office関連, OneNote, Microsoft Graph, Office 365
Microsoft GraphをVBAから呼び出してOneNoteのページ内容を取得する

2015.12.3

Microsoft GraphをVBAから呼び出してOneNoteのページ内容を取得する

以前書いた記事「Office 365 unified APIをVBAから呼び出す」で、VBAからOffice 365 unified APIを呼び出す方法を紹介しましたが、「Office Dev Center – Office 365 unified API (PREVIEW)」に下記記述があるように、Office 365 unified APIは「Microsoft Graph」に変更されました。

Office 365 unified API is now Microsoft Graph.
Go to http://graph.microsoft.com to learn more.

Microsoft Graphといえば、同名のアプリケーションが昔のOffice製品に組み込まれていたので何やらややこしい感じがしますが、そちらはとっくに廃れたツールになっているので、最早どうでも良いのでしょう。

さて、新しくなったunified API、もといMicrosoft Graphを試すに当たり、Connect (); // 2015 で「Excel REST API」に関するセッションがあったので、さっそくこれを試してみようと思ったのですが、リファレンスに

The Excel REST APIs are not yet released.

とあるように、まだ試すことができませんでした(2015/12/1 時点)。

ならば仕方がない、ということで、代わりにOneNote APIをVBAから呼び出すことにしました。

下準備

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

アプリケーションの種類：ネイティブクライアントアプリケーション
リダイレクト URI：http://localhost/onenote
他のアプリケーションに対するアクセス許可：Microsoft Graph
デリゲートされたアクセス許可：Read and write notebooks that the user can access (preview)

取得するOneNoteのページ

今回は下図のように、OneDriveに置いてある「SampleNote」の中にある「SamplePage」の内容を取得してみます。

VBAコード

さっそく書いたコードが下記になります。
基本的なところはOffice 365 unified APIの呼び出しとほぼ同じですね。

authorization code取得
↓
access token取得
↓
https://graph.microsoft.com/beta/me/notes/pages にリクエストを投げてページID取得
↓
取得したページIDをもとに https://graph.microsoft.com/beta/me/notes/pages/(page_id)/content にリクエストを投げてページ内容取得

といった流れになります。

Option Explicit

Public Sub SampleOneNoteAPI()
'サンプル - Microsoft Graph(OneNote)呼び出し
'※ 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 page_id As String
  Dim content As String
  Dim dat As Variant
  Dim ary As Variant, ary2 As Variant
  Dim req As Object
  Dim pages As Object
  Dim page As Object
  Dim i As Long
  Dim value, title, id 'JSONパース用ダミー
  Const READYSTATE_COMPLETE = 4
  
  '***********************************
  '※ 要変更
  '***********************************
  Const client_id As String = "(クライアント ID)" 'クライアント ID
  Const redirect_uri As String = "http://localhost/onenote" 'リダイレクト URI
  Const page_title As String = "SamplePage" '取得するページのタイトル
  '***********************************
  
  '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 & ")"
  With CreateObject("ScriptControl")
    .Language = "JScript"
    access_token = .CodeObject.eval(js).access_token
  End With
  If Len(Trim(access_token)) < 1 Then Exit Sub
  
  'Microsoft Graph呼び出し
  js = "": page_id = "": content = "" '初期化
  url_api = "https://graph.microsoft.com/beta/me/notes/pages"
  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
    If Len(Trim(js)) < 1 Then Exit Sub
    
    '指定したページのID取得
    js = "(" & js & ")"
    With CreateObject("ScriptControl")
      .Language = "JScript"
      Set pages = .CodeObject.eval(js).value
      For Each page In pages
        If page.title = page_title Then
          page_id = page.id
          Exit For
        End If
      Next
    End With
    If Len(Trim(page_id)) < 1 Then Exit Sub
    
    '指定したページの内容(html)取得
    url_api = "https://graph.microsoft.com/beta/me/notes/pages/" & page_id & "/content"
    .Open "GET", url_api, False
    .setRequestHeader "Authorization", "Bearer " & access_token
    .send
    Select Case .Status
      Case 200: content = .responseText
      Case Else: Debug.Print .responseText
    End Select
    If Len(Trim(content)) < 1 Then Exit Sub
  End With
  
  '取得したページ内容をIEで表示
  With CreateObject("InternetExplorer.Application")
    .Visible = True
    .AddressBar = False
    .MenuBar = False
    .StatusBar = False
    .Toolbar = False
    .Width = 600
    .Height = 480
    .Navigate "about:blank"
    While .ReadyState <> READYSTATE_COMPLETE Or _
          .Busy = True
      DoEvents
    Wend
    With .document
      .Open
      .Write content
      .Close
    End With
  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

上記コードを実行すると、下図のように認証画面が表示され、