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関連

    蛍光ペンでマークした部分の文字数をカウントするWordマクロ

    Twitterでたまたま下記のツイートを見つけたので、簡単な処理を考え…

  2. Office関連

    関数一覧(Excel 2010)

    関数の挿入ダイアログから抽出したExcel 2010の関数情報をリスト…

  3. Office関連

    ZIP形式で圧縮・解凍を行うVBAマクロ

    この記事のように、処理の中でZIP形式のファイルを扱うことはありました…

  4. Office関連

    64ビット環境かどうかを判別するVBAマクロ

    2年以上前にMicrosoft Community(当時はMicros…

  5. Office関連

    Trello APIを使ってカードを投稿するVBAマクロ

    以前Fiddlerを使ってTrello APIを実行する記事を書きまし…

  6. Office関連

    ポータブル デバイスからファイルをコピーするVBAマクロ

    mougにあった質問関連のメモです。ポータブル デバイスか…

コメント

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

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

Time limit is exhausted. Please reload CAPTCHA.

最近の記事

アーカイブ

RapidSSL_SEAL-90x50
PAGE TOP