Office関連

Office 365 unified APIをVBAから呼び出す

前回の記事で、VBAからOffice 365 APIを呼び出す手順についてまとめました。
OAuth 2.0 認証 + RESTという一般的な方式で、言語環境を選ばず手軽に外部からOffice 365の情報を取得することができる、とても便利なAPIです。

しかし、Office 365の各サービスのAPIのほとんどは固有のエンドポイントを持っており、複数のサービスにまたがる処理を実行しようとすると、SharePointに行ってOneDriveに行ってOutlookに行って…というように、非常に手間が掛かります。

そこで登場したのが「Office 365 unified API」です。

unified、つまり統一されたエンドポイントが用意されたことで、複数のサービスにまたがる処理であっても、単一のエンドポイント「https://graph.microsoft.com/」にアクセスすればそれでOK!になったわけです。

これはとても便利!
・・・というわけで、早速“VBAから”使ってみることにしました。

VBAからのOffice 365 unified API呼び出し

※ Office 365とAzure ADの紐付けや設定については、ここでは詳しく説明しませんので、「Office 365 APIをVBAから呼び出す(1)」と「Office 365 APIをVBAから呼び出す(2)」をご参照ください。

  1. Azure ポータルにサインインし、「Active Directory」から「ネイティブ クライアント アプリケーション」を追加します。
  2. 「他のアプリケーションに対するアクセス許可」から「Office 365 unified API (preview)」を追加します。
  3. Office_365_unified_API_VBA_01_01

  4. 今回はメール情報を取得するマクロを書く予定なので「デリゲートされたアクセス許可」から「Read and write access to user mail」を選択します。
  5. Office_365_unified_API_VBA_01_02

  6. 保存」ボタンをクリックして変更を保存します。アプリケーションの構成画面に表示されている「クライアント ID」と「リダイレクト URI」は後で必要になるので、どこかに控えておきます。
  7. 以上で準備作業は完了です。
    次は実際にマクロを書いて実行してみます。

  8. 下記コードを標準モジュールに貼り付け、「client_id」と「redirect_uri」をそれぞれ自分が取得・設定したものに置きかえます。
  9. Option Explicit
    
    Public Sub SampleOutlookAPI()
    'サンプル - Office 365 unified API(Messages)呼び出し
    '※ 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 dat As Variant
      Dim ary As Variant, ary2 As Variant
      Dim messages As Object
      Dim message As Object
      Dim i As Long
      Dim value, Subject, BodyPreview 'JSONパース用ダミー
      Const READYSTATE_COMPLETE = 4
      
      '**********************************************************************
      'クライアント ID & リダイレクト URI
      Const client_id As String = "(取得したクライアント ID)"
      Const redirect_uri As String = "(設定したリダイレクト URI)"
      '**********************************************************************
      
      '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
        .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
        .Quit
      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)
      With CreateObject("MSXML2.XMLHTTP")
        .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
      
      'Office 365 unified API呼び出し
      js = "" '初期化
      url_api = "https://graph.microsoft.com/beta/me/messages"
      With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", url_api, False
        .setRequestHeader "Authorization", "Bearer " & access_token
        .send
        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"
        Set messages = .CodeObject.eval(js).value
        For Each message In messages
          Debug.Print message.Subject, message.BodyPreview '件名・本文プレビュー列挙
        Next
      End With
    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
  10. 上記コードを実行しOffice 365のアカウントでサインインすると、APIの呼び出しが行われ、メール情報がイミディエイト ウィンドウに出力されます。
  11. Office_365_unified_API_VBA_01_03

以上の手順でOffice 365 unified APIをVBAから呼び出すことができたわけですが、実は上記コードは「Office 365 APIをVBAから呼び出す(3)」のコードとほぼ同じものになっています。

違うのはリソースのURI(https://graph.microsoft.com/)とRESTサービスのURI(https://graph.microsoft.com/beta/me/messages)だけで、その他の部分は同じコードです。

要はコードの使い回しですが、見方を変えると、これまでのOffice 365 APIを呼び出すコードがほぼそのまま使えるわけです。

2015/05/22 時点では、まだOffice 365 unified APIはプレビュー版ですが、単一のエンドポイントからOffice 365のリソースにアクセスできる、という仕様が変わることはないだろうと思います。

認証フローがシンプルになって、これまで以上にOffice 365関連サービスが開発がしやすくなりましたね!!

関連記事

関連記事

  1. Office関連

    Excel 2013で駅すぱあとWebサービス APIの「経路探索」を使ってみました。

    「「駅すぱあとWebサービス API無償提供」を利用してみました。」で…

  2. Office関連

    PowerPoint 2013でYouTubeの動画を挿入する。

    2014/5/23 追記:いつの間にか「ビデオの挿入ダイアログ」が…

  3. Excel

    [VBA]ファイルタブ(Backstage ビュー)の表示を禁止する。

    数年前ホームページで「ファイルタブボタンのクリックを禁止する(Offi…

  4. Office関連

    [Excel Services ECMAScript]選択範囲が変更されたときのイベントを利用する。…

    埋め込んだExcelワークブックの、選択範囲が変更されたときのイベント…

  5. Office関連

    [Word VBA]ルビ(ふりがな)ダイアログの操作に挑む(2)

    2016/10/28 追記:改良版のマクロを書きました。…

  6. Office関連

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

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

コメント

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

  1. この記事へのトラックバックはありません。

Time limit is exhausted. Please reload CAPTCHA.

最近の記事

アーカイブ

RapidSSL_SEAL-90x50
PAGE TOP