VBAマクロからGoogle Apps Script Execution APIを呼び出す。

ホーム
Office関連, Excel, Word, PowerPoint, Google関連
VBAマクロからGoogle Apps Script Execution APIを呼び出す。

2015.11.19

VBAマクロからGoogle Apps Script Execution APIを呼び出す。

「Google Apps Script Execution APIを試してみた。」記事を書いてからひと月経ってしまいましたが、ようやく時間がとれるようになったので、当初の目的であった“VBAからGoogle Apps Script Execution APIを呼び出してみたい！”と思います。

実行するGASコード

呼び出すGoogle Apps Scriptのコードは「Google Apps Script Execution APIを試してみた。」記事のものをそのまま使います。

上記記事でも書いていますが、API呼び出し前に必ず myFunction を実行して動作確認を行ってください。

function getSheetNames(sheetId) {
  var ss = SpreadsheetApp.openById(sheetId);
  var sheets = ss.getSheets();
  return sheets.map(function(sheet) {
    return sheet.getName();
  });
}

function myFunction() {
  Logger.log(getSheetNames("シートID"));
}

下準備

Execution APIを呼び出すに当たり、下記の作業が事前に必要となりますが、作業手順は「Google Apps Script Execution APIを試してみた。」記事をご参照ください。

実行可能 API として導入
API IDの取得
スコープの取得
Google Apps Script Execution APIの有効化
クライアント IDとクライアントシークレットの取得

ただし、“スクリプトにアクセスできるユーザー”は「自分のみ」、

認証情報は OAuth 2.0 クライアント ID → アプリケーションの種類：その他としてください。

Google Apps Script Execution APIを呼び出すVBAコード

いよいよExecution APIを呼び出すVBAコードです。
API ID、クライアント ID、クライアントシークレット、スコープ、実行するGAS関数名、関数に渡すパラメーターは、それぞれ自分の環境に応じて変更してください。

Option Explicit
'スクリプトにアクセスできるユーザー:自分のみ
'OAuth 2.0 クライアント ID(アプリケーションの種類:その他)
'devMode:false

'--------------------------------------------------
'※ 要変更
'--------------------------------------------------
Private Const api_id As String = "API ID"
Private Const client_id As String = "クライアント ID"
Private Const client_secret As String = "クライアント シークレット"
'--------------------------------------------------

Private Const response_type As String = "code"
Private Const redirect_uri As String = "urn:ietf:wg:oauth:2.0:oob"
Private Const grant_type As String = "authorization_code"

Public Sub Sample()
  Dim auth_code As String
  Dim access_token As String
  Dim ret As String
  Const scope As String = "https://www.googleapis.com/auth/spreadsheets" 'スコープ
  Const function_name As String = "getSheetNames" '実行するGAS関数名
  Const sheet_id As String = "シートID"
  
  '初期化
  ret = "": auth_code = "": access_token = ""
  auth_code = GetAuthorizationCode(scope)
  If Len(Trim(auth_code)) < 1 Then Exit Sub
  access_token = GetAccessToken(auth_code)
  If Len(Trim(access_token)) < 1 Then Exit Sub
  ret = ExecuteGASFunction(access_token, api_id, function_name, sheet_id)
  Debug.Print "result:" & ret
End Sub

Private Function ExecuteGASFunction(ByVal access_token As String, _
                                    ByVal api_id As String, _
                                    ByVal function_name As String, _
                                    ByVal parameters As String, _
                                    Optional ByVal dev_mode As String = "false")
'Google Apps Script Execution API呼び出し
  Dim ret As String
  Dim url As String
  Dim json As String
  Dim dat As Variant
  Dim d As Object
  Dim elm As Object
  
  ret = "" '初期化
  dat = "{'function':'" & function_name & "','parameters':'" & parameters & "','devMode':" & dev_mode & "}"
  url = "https://script.googleapis.com/v1/scripts/" & api_id & ":run"
  With CreateObject("WinHttp.WinHttpRequest.5.1")
    .Open "POST", url, False
    .SetRequestHeader "Content-Type", "application/json; charset=UTF-8"
    .SetRequestHeader "Authorization", "Bearer " & access_token
    .Send dat
    Select Case .Status
      Case 200
        json = "(" & .responseText & ")"
        Set d = CreateObject("htmlfile")
        Set elm = d.createElement("span")
        elm.setAttribute "id", "result"
        d.body.appendChild elm
        d.parentWindow.execScript "document.getElementById('result').innerText=eval(" & json & ").response.result;"
        ret = elm.innerText
    End Select
  End With
  ExecuteGASFunction = ret
End Function

Private Function GetAuthorizationCode(ByVal scope As String) As String
'Authorization code取得
  Dim ie As Object
  Dim url As String
  Dim iptCode As Object
  Dim auth_code As String
  Const READYSTATE_COMPLETE = 4
  
  '初期化
  Set ie = Nothing
  Set iptCode = Nothing
  auth_code = ""
  
  url = "https://accounts.google.com/o/oauth2/auth?" & _
        "client_id=" & client_id & "&" & _
        "response_type=" & response_type & "&" & _
        "redirect_uri=" & redirect_uri & "&" & _
        "scope=" & EncodeURL(scope)
  
  Set ie = CreateObject("InternetExplorer.Application")
  With ie
    .Visible = True
    .AddressBar = False
    .MenuBar = False
    .StatusBar = False
    .Toolbar = False
    .Width = 600
    .Height = 480
    .Navigate url
    
    While .Busy Or _
          .readyState <> READYSTATE_COMPLETE Or _
          InStr(LCase(.LocationURL), "https://accounts.google.com/o/oauth2/approval") < 1
      DoEvents
    Wend
    
    On Error Resume Next
    Set iptCode = .document.getElementById("code")
    On Error GoTo 0
    If Not iptCode Is Nothing Then auth_code = iptCode.Value
    
    .Navigate "https://accounts.google.com/o/logout" 'ログアウト
    While .Busy Or .readyState <> READYSTATE_COMPLETE
      DoEvents
    Wend
    .Quit
  End With
  GetAuthorizationCode = auth_code
End Function

Private Function GetAccessToken(ByVal auth_code As String) As String
'Access token取得
  Dim access_token As String
  Dim json As String
  Dim dat As Variant
  Dim d As Object
  Dim elm As Object
  
  access_token = "" '初期化
  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", "https://www.googleapis.com/oauth2/v3/token", False
    .SetRequestHeader "Content-Type", "application/x-www-form-urlencoded;charset=UTF-8"
    .Send dat
    If .Status = 200 Then
      json = .responseText
      If Len(Trim(json)) > 0 Then
        json = "(" & .responseText & ")"
        Set d = CreateObject("htmlfile")
        Set elm = d.createElement("span")
        elm.setAttribute "id", "result"
        d.body.appendChild elm
        d.parentWindow.execScript "document.getElementById('result').innerText=eval(" & json & ").access_token;"
        access_token = elm.innerText
      End If
    End If
  End With
  GetAccessToken = access_token
End Function

Private Function EncodeURL(ByVal str As String) As String
'URLエンコード
  Dim d As Object
  Dim elm As Object
  
  str = Replace(str, "\", "\\")
  str = Replace(str, "'", "\'")
  Set d = CreateObject("htmlfile")
  Set elm = d.createElement("span")
  elm.setAttribute "id", "result"
  d.body.appendChild elm
  d.parentWindow.execScript "document.getElementById('result').innerText = encodeURIComponent('" & str & "');"
  EncodeURL = elm.innerText
End Function

上記コードを実行すると、Internet Explorerが表示され、認証とAPIの呼び出しが問題なく行われれば、イミディエイトウィンドウに指定したスプレッドシートのシート名が表示されます。

これでようやく、VBAからGoogle Apps Script Execution APIを呼び出せることが確認できました。
外部からGAS関数を呼び出せるメリットはとても多く、「Execution API でどこからでも Apps Script コードが実行可能に – Google Developer Japan Blog」にも下記のような記述があります。

Execution API は、Microsoft Office (と VBA) から Apps (と Apps Script) へ「徐々に移行」することを実現する優れたツールです。Office の成熟したワークフローには、VBA で構成されている多くのプロセスが含まれており、さまざまな場所のさまざまな形式のデータを扱う必要があります。特に、多くの要素が移動する自動化されたプロセスでは、1 つの手順でワークロード全体を動かすことが難しくなることもあります。この新しい機能を使用すると、管理可能な規模でデータとプロセスの移行が行えます

上記コメントをしているGoogle Developer ExpertのBruce Mcpherson氏は、正直「ここまでVBAでやるか？」というようなコードをGitHubに載せています(Execution API and Office to Apps migration 参照)。
VBAとGoogle APIの連携をする上で非常に参考になるコードですので、興味がある方は是非ファイルをダウンロードしてコードを見てみてください。

・・・ちなみに、今回のコードを書くに当たり、認証周りでかなりつまづきました。
もしAPIの呼び出しで上手くいかないようであれば、「スクリプトにアクセスできるユーザー」と「devMode」の組み合わせを色々変更してみてください。私はそれで上手くいくようになりました。