Office関連

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を試してみた。」記事をご参照ください。

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

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

GoogleAppsScriptExecutionAPI_fromVBA_01

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

GoogleAppsScriptExecutionAPI_fromVBA_02

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の呼び出しが問題なく行われれば、イミディエイト ウィンドウに指定したスプレッドシートのシート名が表示されます。

GoogleAppsScriptExecutionAPI_fromVBA_03

GoogleAppsScriptExecutionAPI_fromVBA_04

GoogleAppsScriptExecutionAPI_fromVBA_05

GoogleAppsScriptExecutionAPI_fromVBA_06

これでようやく、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」の組み合わせを色々変更してみてください。私はそれで上手くいくようになりました。

オフライン版のOffice 2016 VBAリファレンスが公開されました。前のページ

2015年11月の人気記事次のページ

関連記事

  1. Office関連

    Office XP Developer Toolsでリボン対応のCOMアドインを作成する。

    「Visual Basic 6でリボン対応のアドインを作成する」ではV…

  2. アイコン一覧

    Office 2013 アイコン一覧(U)

    ・Office 2013 アイコン一覧 NUM…

  3. アイコン一覧

    Office 2013 アイコン一覧(X,Y,Z)

    ・Office 2013 アイコン一覧 NUM…

  4. Office アドイン

    [Office用アプリ]Excel 2013の操作を動画で学べるアプリ「Excel video tu…

    Excel 2013の操作を動画で学べるアプリがMicrosoftから…

  5. Office関連

    [Office 2013]オンライン テンプレートを無効にする。

    前回の記事ではOffice 2013でSkyDriveを無効にする方法…

コメント

  • コメント (1)

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

    • ミン
    • 2021年 3月 07日 8:23pm

    勉強になりました。これからGASを勉強しようとしています。
    これを参考にPowershellからGASを呼べるようにするところが目標です

Time limit is exhausted. Please reload CAPTCHA.

Translate

最近の記事

アーカイブ

PAGE TOP