Office関連

Google Docs APIを使ってGoogle ドキュメントを操作するVBAマクロ

前回の記事で新しく追加されたGoogle Docs APIを紹介しました。

今回はDocs APIをVBAから呼び出して、既存ドキュメントの情報の取得や新規ドキュメントの作成を行いたいと思います。

大まかな処理の流れ

VBAからDocs APIを呼び出す場合、大まかな処理の流れは下記のようになります。

authorization code取得

access token取得

Authorizationヘッダーにaccess tokenを含めてAPI呼び出し

一般的なREST APIの呼び出しと同様ですね!

クライアントIDとクライアントシークレットの取得

※下記手順は 2019/2/18 時点のものです。今後のバージョンアップによって、画面や手順が変更される可能性がありますので、その点はご注意ください。

まずはAPIの呼び出しに必要なクライアントIDとクライアントシークレットを取得します。

  1. Google Developers Consoleにアクセスし、Google アカウントでログインします。
  2. ダッシュボード画面が表示されるので、「プロジェクトの選択」から「新しいプロジェクト」を選択します。既存のプロジェクトを使用したい場合は、新しいプロジェクトではなく既存プロジェクトを選択してください。
  3. 新しいプロジェクト画面が表示されるので、プロジェクト名を入力し、「作成」ボタンをクリックします。
  4. プロジェクトが作成されたら、作成されたプロジェクトが選択されていることを確認し、「ライブラリ」をクリックします。
  5. 検索ボックスに“docs”と入力し、結果としてヒットする「Google Docs API」をクリックします。
  6. 有効にする」ボタンをクリックします。
  7. Google Docs AP画面が表示されるので、「認証情報」から「認証情報を作成」ボタンをクリックします。
  8. 使用するAPIは「Google Docs AP」、APIを呼び出す場所は「その他のUI (Windows、 CLI ツールなど)」、アクセスするデータの種類は「ユーザーデータ」を選択し、「必要な認証情報」ボタンをクリックします。
  9. 適当なOAuthクライアント名を入力し、「OAuth クライアント IDを作成」ボタンをクリックします。
  10. OAuth 2.0 同意画面のメールアドレスとユーザーに表示するサービス名を入力し、「次へ」ボタンをクリックします。
  11. クライアントIDが表示されたら「完了」ボタンをクリックします。
  12. 認証情報画面から、作成したクライアントの「OAuth クライアントを編集」ボタンをクリックします。
  13. クライアントIDとクライアントシークレットが表示されるので、メモ帳などのテキストエディタにコピーしておきます。

Google Docs APIを使ってGoogle ドキュメントを操作するVBAマクロ

下準備ができたので実際にコードを書いていきます。
認証処理など、詳しい処理の流れはGoogle Developers ガイドをご参照ください。

下記コードはScriptControlを使用しているため、64ビット版のOfficeでは動作しません。
また、実行する際はコード中のclient_id、client_secret、document_idを書き換えてください。

Option Explicit

'--------------------------------------------------
'※ 要変更
'--------------------------------------------------
Private Const client_id As String = "(クライアントID)"
Private Const client_secret As String = "(クライアントシークレット)"
Private Const document_id As String = "(情報を取得したいドキュメントのID)"
'--------------------------------------------------
Private Const redirect_uri As String = "urn:ietf:wg:oauth:2.0:oob"

Public Sub CallGoogleDocsAPI()
'Google Docs API v1の呼び出し
  Dim access_token As String
  Dim json_str As String
  Dim new_document_id As String
  Dim sc As Object
  Dim json As Object
  Dim req As Object
  Dim dat As Variant
  Const request_base_url As String = "https://docs.googleapis.com/v1/documents"
  
  access_token = GetAccessToken
  If Len(Trim(access_token)) > 0 Then
    Set req = CreateObject("WinHttp.WinHttpRequest.5.1")
    Set sc = CreateObject("ScriptControl")
    sc.Language = "JScript"
    
    '指定したドキュメントのタイトル取得
    With req
      .Open "GET", request_base_url & "/" & document_id, False
      .SetRequestHeader "Content-Type", "application/json; charset=UTF-8"
      .SetRequestHeader "Authorization", "Bearer " & access_token
      .Send
      Select Case .Status
        Case 200
          json_str = "(" & .responseText & ")"
          Set json = sc.CodeObject.eval(json_str)
          Debug.Print "ドキュメントのタイトル:" & VBA.CallByName(json, "title", VbGet)
      End Select
    End With
    
    '新規ドキュメントの作成
    With req
      dat = "{""title"": ""APIから作成した文書""}" 'タイトル設定
      .Open "POST", request_base_url, False
      .SetRequestHeader "Content-Type", "application/json; charset=UTF-8"
      .SetRequestHeader "Authorization", "Bearer " & access_token
      .Send dat
      Select Case .Status
        Case 200
          json_str = "(" & .responseText & ")"
          Set json = sc.CodeObject.eval(json_str)
          new_document_id = VBA.CallByName(json, "documentId", VbGet)
      End Select
    End With
    
    '文字列の挿入
    If Len(Trim(new_document_id)) > 0 Then
      With req
        dat = "{""requests"":[{""insertText"":{""location"":{""index"":1},""text"":""こんにちは、世界!""}}]}" '挿入する文字列設定
        .Open "POST", request_base_url & "/" & new_document_id & ":batchUpdate", False
        .SetRequestHeader "Content-Type", "application/json; charset=UTF-8"
        .SetRequestHeader "Authorization", "Bearer " & access_token
        .Send dat
        Select Case .Status
          Case 200
            Debug.Print "新規作成した文書(ドキュメントID:" & new_document_id & ")への文字列挿入が成功しました。"
        End Select
      End With
    End If
  End If
End Sub

Private Function GetAccessToken() As String
'access token取得
  Dim auth_code As String
  Dim access_token As String
  Dim json_str As String
  Dim sc As Object
  Dim json As Object
  Dim dat As Variant
  Const token_base_url As String = "https://accounts.google.com/o/oauth2/token"
  Const grant_type As String = "authorization_code"
  
  auth_code = GetAuthorizationCode
  If Len(Trim(auth_code)) > 0 Then
    dat = "code=" & auth_code & "&" & _
          "client_id=" & client_id & "&" & _
          "client_secret=" & client_secret & "&" & _
          "redirect_uri=" & redirect_uri & "&" & _
          "grant_type=" & grant_type
    With CreateObject("WinHttp.WinHttpRequest.5.1")
      .Open "POST", token_base_url, False
      .SetRequestHeader "Content-Type", "application/x-www-form-urlencoded;charset=UTF-8"
      .Send dat
      Select Case .Status
        Case 200
          Set sc = CreateObject("ScriptControl")
          sc.Language = "JScript"
          json_str = "(" & .responseText & ")"
          Set json = sc.CodeObject.eval(json_str)
          access_token = VBA.CallByName(json, "access_token", VbGet)
      End Select
    End With
  End If
  GetAccessToken = access_token
End Function

Private Function GetAuthorizationCode() As String
'authorization code取得
  Dim url_auth As String
  Dim approval_title As String
  Dim code As String
  Dim scopes As Variant
  Dim ary As Variant, ary2 As Variant
  Dim i As Long
  Const READYSTATE_COMPLETE = 4
  Const auth_base_url As String = "https://accounts.google.com/o/oauth2/auth"
  Const approval_url As String = "https://accounts.google.com/o/oauth2/approval/"
  Const response_type As String = "code"
  
  'スコープ設定
  scopes = Array("https://www.googleapis.com/auth/drive", _
                 "https://www.googleapis.com/auth/documents")
  
  url_auth = auth_base_url & "?redirect_uri=" & EncodeURL(redirect_uri) & _
             "&client_id=" & client_id & _
             "&response_type=" & response_type & _
             "&scope=" & EncodeURL(Join(scopes, " "))
  
  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(approval_url)), approval_url) <> 0)
      DoEvents
    Wend
    approval_title = .document.Title
    .Quit
  End With
  
  If InStr(approval_title, "Success ") Then
    approval_title = Replace(approval_title, "Success ", "")
    ary = Split(approval_title, "&")
    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 If
  GetAuthorizationCode = code
End Function

Private Function EncodeURL(ByVal str As String) As String
'URLエンコード
  With CreateObject("ScriptControl")
    .Language = "JScript"
    EncodeURL = .CodeObject.encodeURIComponent(str)
  End With
End Function

実行結果

上記コード(CallGoogleDocsAPI)を実行し、問題なくAPIの呼び出しが行われると、指定したドキュメントのタイトルの取得(documents.get)と、新規ドキュメントの作成(documents.create)、及び文字列の挿入(documents.batchUpdate)が行われます。

Docs APIを使って具体的にどのような処理ができるのかは、公式のリファレンスを見ると良いでしょう。

おわりに

APIの呼び出しはJSONでやり取りすることになるので、上記コードを見れば分かる通り、素のVBAでは処理が非常に冗長になります。

認証含めて、いちいち面倒くさい処理を行わなければならないので、私個人としてはVBAからのAPI呼び出しは正直お薦めしません😅

ただ単にAPIを試したいだけであれば、素直にGoogle APIs Explorerを使うことをお薦めします。

関連記事

Google Docs API v1を試してみました。前のページ

[PowerPoint]シェイプの名前を指定して「変形」ができるようになりました。次のページ

関連記事

  1. Office関連

    Wordの自動実行マクロ

    たまたま使用する機会があったのでメモ書き程度に情報を残しておきます。…

  2. アイコン一覧

    Office 2013 アイコン一覧(F)

    ・Office 2013 アイコン一覧 NUM…

  3. Office関連

    オフィス祭り 2018 in 東京に参加しました。

    先日書いた下記記事の通り、9月15日(土)に品川にある日本マイクロソフ…

  4. Office関連

    類似した書式の文字列を選択するWordマクロ三種

    Wordには、選択中の文字列と似た書式の文字列を一括選択する「類似した…

  5. アイコン一覧

    Office 2013 アイコン一覧(Q)

    ・Office 2013 アイコン一覧 NUM…

  6. Office関連

    ファイルをブックに埋め込むExcelマクロ

    大分前に書いた回答用のコードが出てきたので、記事として残しておきます。…

コメント

  • コメント (0)

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

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

Time limit is exhausted. Please reload CAPTCHA.

Translate

最近の記事

アーカイブ

PAGE TOP