今回はVBAを用いたGoogle APIの認証方法を紹介します。
使用するAPIはGoogle Analytics APIです。
■OAuth 2.0認証
最近のGoogle APIは全てOAuth 2.0認証が必要でこの認証を用いてAPIの通信を行うようになっています。ですのでVBAからGoogle APIを使用する時もOAuth 2.0認証が必要になります。
詳しくは参考サイトのOAuth 2.0認証を参照してください。
■Google Developer Consoleでの設定
Google Developer Consoleでは認証に必要な「クライアントID」「クライアント シークレット」「リダイレクトURI」を取得し、使用するAPIを有効にします。
まずGoogle Developer Consoleにアクセスし、適当なプロジェクトを選択します。
左メニューの「認証情報」からOAuthの「新しいクライアントIDを作成」を選択します。
アプリケーションの種類に「インストールされているアプリケーション」、インストールされているアプリケーションの種類に「その他」を選択しクライアントIDを作成します。
作成すると下図のような「クライアントID」「クライアント シークレット」「リダイレクトURI」が表示されるのでメモしておきます。
そして左メニューの「API」から今回使用するGoogle Analytics APIを有効にします。
■VBAでのAPI通信の認証方法
方法はまず認証用コードを取得します。次に認証用コードを使ってアクセストークンを取得します。アクセストークンをヘッダーに付加してリクエストを行うことでAPI通信ができるようになります。
認証情報の定義、認証用コードの取得、アクセストークンの取得に分けて説明を行います。
○認証情報の定義
認証に必要な情報を定義します。
Google Developer ConsoleにアクセスしたGmailのアカウントとパスワード、Google Developer Consoleで取得した「クライアントID」「クライアント シークレット」「リダイレクトURI」を定義します。
それから今回使用するGoogle Analytics APIのスコープ(認証の範囲)を定義します。
※各APIにそれぞれスコープがあります。
1 2 3 4 5 6 | Private Const email As String = "Gmailアカウント" Private Const password As String = "Gmailパスワード" Private Const client_id As String = "クライアントID" Private Const client_secret As String = "クライアント シークレット" Private Const redirect_uri As String = "リダイレクトURI" Private Const scope As String = "https://www.googleapis.com/auth/analytics.readonly" |
○認証用コードの取得
ここではInternet Explorerを自動で開き認証用コードを取得する方法を取ります。
下記の手順で説明します。
1.認証用URLを作成
2.Internet Explorerで認証用URLにアクセス
3.ログイン処理
4.承認処理
5・認証用コード取得処理
1.認証用URLの作成
認証用URLはベースとなるURL(https://accounts.google.com/o/oauth2/auth?)に
client_id、response_type、redirect_uri、scopeのパラメータを足したものです。
1 2 3 4 5 6 | Dim sUrl As String sUrl = "https://accounts.google.com/o/oauth2/auth?" & _ "client_id=" & client_id & "&" & _ "response_type=code" & "&" & _ "redirect_uri=" & redirect_uri & "&" & _ "scope=" & scope |
2.Internet Explorerで認証用URLにアクセス
readyStateが4になるまで待ち、全データ読込完了状態します。
この処理をしないとエラーが発生します。
1 2 3 4 5 6 7 8 | Dim oIE As Object Set oIE = CreateObject("InternetExplorer.Application") With oIE .Visible = False 'IEのブラウザを表示するか否か .Navigate sUrl While oIE.readyState <> 4 DoEvents Wend |
3.ログイン処理
ログイン処理では複数のアカウントがある時とログインしていない時の処理をします。
アカウントが1つの時の処理
1 2 3 4 5 6 7 8 9 10 11 12 | Dim ancAcl As Object If InStr(LCase(.document.Location.href), "https://accounts.google.com/servicelogin") Then With .document On Error Resume Next Set ancAcl = .getElementById("account-chooser-link") On Error GoTo 0 If Not ancAcl Is Nothing Then ancAcl.Click End With While oIE.readyState <> 4 DoEvents Wend End If |
複数のアカウントがある時の処理
ここでは該当するアカウントがあっても処理が複雑になるので画面をスルーしています。
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 | Dim oAcaa As Object Set oAcaa = Nothing If InStr(LCase(.document.Location.href), "https://accounts.google.com/accountchooser") Then With .document On Error Resume Next Set oAcaa = .getElementById("account-chooser-add-account") On Error GoTo 0 If Not oAcaa Is Nothing Then oAcaa .Click End With While oIE.readyState <> 4 DoEvents Wend ElseIf InStr(LCase(.document.Location.href), "https://accounts.google.com/servicelogin") Then With .document On Error Resume Next Set oAcaa = .getElementById("account-chooser-add-account") On Error GoTo 0 If Not oAcaa Is Nothing Then oAcaa .Click End With While oIE.readyState <> 4 DoEvents Wend End If |
ログインしていない時の処理
Gmailアカウントとパスワードの値を入力しサインインします。
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 | Dim oEmail As Object Set oEmail = Nothing Dim oPassword As Object Set oPassword = Nothing Dim oSignIn As Object Set oSignIn = Nothing If InStr(LCase(.document.Location.href), "https://accounts.google.com/servicelogin") Then With .document On Error Resume Next Set iptEmail = .getElementById("Email") If Not iptEmail Is Nothing Then iptEmail.Value = email Set iptPasswd = .getElementById("Passwd-hidden") If Not iptPasswd Is Nothing Then iptPasswd.Value = passwd Application.Wait Now + TimeValue("00:00:01") .getElementById("next").Click Set iptSignIn = .getElementById("signIn") Application.Wait Now + TimeValue("00:00:01") If Not iptSignIn Is Nothing Then iptSignIn.Click End With While oIE.readyState <> 4 DoEvents Wend End If |
4.承認処理
承認を求められるので承認を行います。
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 | Dim oApprove As Object Set oApprove = Nothing If InStr(LCase(.document.Location.href), "https://accounts.google.com/o/oauth2/auth") Then With .document On Error Resume Next Set btnApprove = .getElementById("submit_approve_access") On Error GoTo 0 If Not oApprove Is Nothing Then While oApprove.disabled <> False DoEvents Wend oApprove.Click End If End With While oIE.readyState <> 4 DoEvents Wend End If |
5.認証用コード取得処理
認証用コードが表示されるので認証用コードを取得します。
1 2 3 4 5 6 7 8 9 10 11 12 13 14 | Dim oCode As Object Dim auth_code As String If InStr(LCase(.document.Location.href), "https://accounts.google.com/o/oauth2/approval") Then With .document On Error Resume Next Set oCode = .getElementById("code") On Error GoTo 0 If Not oCode Is Nothing Then auth_code = oCode.Value End With While oIE.readyState <> 4 DoEvents Wend End If .Quit |
○アクセストークンの取得
アクセストークンは認証用コードを用いて取得します。
このアクセストークンを用いてAPIの通信が可能になります。
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 | Dim auth_code As String Dim access_token As String Dim sJson As String Dim vParam As Variant Dim oData As Object Dim oElm As Object auth_code = "認証用コード" If Len(Trim(auth_code)) > 0 Then vParam = "code=" & auth_code & "&" & _ "client_id=" & client_id & "&" & _ "client_secret=" & client_secret & "&" & _ "redirect_uri=" & redirect_uri & "&" & _ "grant_type=authorization_code" With CreateObject("WinHttp.WinHttpRequest.5.1") .Open "POST", "https://accounts.google.com/o/oauth2/token" .setRequestHeader "Content-Type", "application/x-www-form-urlencoded;charset=UTF-8" .send vParam '成功時の処理 If .Status = 200 Then sJson = .ResponseText If Len(Trim(sJson)) > 0 Then sJson = "(" & .ResponseText & ")" Set oData = CreateObject("htmlfile") Set oElm = oData.createElement("span") oElm.setAttribute "id", "result" oData.appendChild oElm oData.parentWindow.execScript "document.getElementById('result').innerText=eval(" & sJson & ").access_token;" access_token = oElm.innerText End If End If End With End If |
アクセストークンをリクエストURLと一緒に送信することにより
APIの通信ができるようになります。
1 2 3 4 5 6 7 8 9 | Dim sUrl As String Dim access_token As String Dim oHTTP As Object access_token = "アクセストークン" sUrl="リクエストURL" oHTTP.Open "GET", sUrl, False oHTTP.setRequestHeader "Authorization", "Bearer " & access_token oHTTP.setRequestHeader "Content-Type", "application/atom+xml" oHTTP.send |
以上がVBAを用いたGoogle APIの認証方法です。
VBAを用いたAPIの開発は資料が少ないので参考になればと思います。
付録に完全なVBAのコードがありますので参考にしてください。
OAuth 2.0認証はどの言語(JavaScript以外)でも同じようなアクセス方法になるようなので、
Google APIでアプリを開発する際は参考になると思います。
アクセストークンの有効期限なのですが、調べたところ公式にありました。
アクセストークンの有効期限はアクセストークン取得時に「expires_in」というパラメータで取得できます。
次回はGoogle Analyticsについて紹介します。
<参考サイト>
OAuth 2.0認証
<付録>
VBAでAPI通信するためのコードです。
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 | 'アカウント等の定義 Private Const email As String = "Gmailアカウント" Private Const password As String = "Gmailパスワード" Private Const client_id As String = "クライアントID" Private Const client_secret As String = "クライアント シークレット" Private Const redirect_uri As String = "リダイレクトURI" Private Const scope As String = "https://www.googleapis.com/auth/analytics.readonly" '認証用コードの取得 Private Function getAuthCode() As String Dim oIE As Object Dim sUrl As String Dim oAcaa As Object Set oAcaa = Nothing Dim oAcl As Object Set oAcl = Nothing Dim oEmail As Object Set oEmail = Nothing Dim oPassword As Object Set oPassword = Nothing Dim oSignIn As Object Set oSignIn = Nothing Dim oCode As Object Set oCode = Nothing Dim oApprove As Object Set oApprove = Nothing Dim auth_code As String '1.認証用URLの作成 sUrl = "https://accounts.google.com/o/oauth2/auth?" & _ "client_id=" & client_id & "&" & _ "response_type=code" & "&" & _ "redirect_uri=" & redirect_uri & "&" & _ "scope=" & scope '2.Internet Explorerで認証用URLにアクセス Set oIE = CreateObject("InternetExplorer.Application") With oIE .Visible = False 'IEのブラウザを表示するか否か .Navigate sUrl Call waitIE(oIE) '3.アカウントが1つの時の処理 If InStr(LCase(.document.Location.href), "https://accounts.google.com/servicelogin") Then With .document On Error Resume Next Set oAcl= .getElementById("account-chooser-link") On Error GoTo 0 If Not oAclIs Nothing Then oAcl.Click End With Call waitIE(oIE) End If '3.複数のアカウントがある時の処理 If InStr(LCase(.document.Location.href), "https://accounts.google.com/accountchooser") Then With .document On Error Resume Next Set oAcaa = .getElementById("account-chooser-add-account") On Error GoTo 0 If Not oAcaa Is Nothing Then oAcaa .Click End With Call waitIE(oIE) ElseIf InStr(LCase(.document.Location.href), "https://accounts.google.com/servicelogin") Then With .document On Error Resume Next Set oAcaa = .getElementById("account-chooser-add-account") On Error GoTo 0 If Not oAcaa Is Nothing Then oAcaa .Click End With Call waitIE(oIE) End If '3.ログインしていない時の処理 If InStr(LCase(.document.Location.href), "https://accounts.google.com/servicelogin") Then With .document On Error Resume Next Set oEmail = .getElementById("Email") If Not oEmail Is Nothing Then oEmail.Value = email Set oPasswd = .getElementById("Passwd-hidden") If Not oPasswd Is Nothing Then oPasswd.Value = passwd Application.Wait Now + TimeValue("00:00:01") .getElementById("next").Click Set oSignIn = .getElementById("signIn") Application.Wait Now + TimeValue("00:00:01") If Not oSignIn Is Nothing Then oSignIn.Click End With Call waitIE(oIE) End If '4.承認処理 If InStr(LCase(.document.Location.href), "https://accounts.google.com/o/oauth2/auth") Then With .document On Error Resume Next Set oApprove = .getElementById("submit_approve_access") On Error GoTo 0 If Not oApprove Is Nothing Then While oApprove.disabled <> False DoEvents Wend oApprove.Click End If End With Call waitIE(oIE) End If '5.認証用コード取得処理 If InStr(LCase(.document.Location.href), "https://accounts.google.com/o/oauth2/approval") Then With .document On Error Resume Next Set iptCode = .getElementById("code") On Error GoTo 0 If Not iptCode Is Nothing Then auth_code = iptCode.Value End With .Navigate "https://accounts.google.com/o/logout" Call waitIE(oIE) End If .Quit End With getAuthCode = auth_code End Function 'アクセストークンの取得 Private Function getAccessToken() As String Dim auth_code As String Dim access_token As String Dim sJson As String Dim vParam As Variant Dim oData As Object Dim oElm As Object auth_code = getAuthCode() If Len(Trim(auth_code)) > 0 Then vParam = "code=" & auth_code & "&" & _ "client_id=" & client_id & "&" & _ "client_secret=" & client_secret & "&" & _ "redirect_uri=" & redirect_uri & "&" & _ "grant_type=authorization_code" With CreateObject("WinHttp.WinHttpRequest.5.1") .Open "POST", "https://accounts.google.com/o/oauth2/token" .setRequestHeader "Content-Type", "application/x-www-form-urlencoded;charset=UTF-8" .send vParam '成功時の処理 If .Status = 200 Then sJson = .ResponseText If Len(Trim(sJson)) > 0 Then sJson = "(" & .ResponseText & ")" Set oData = CreateObject("htmlfile") Set oElm = oData.createElement("span") oElm.setAttribute "id", "result" oData.appendChild oElm oData.parentWindow.execScript "document.getElementById('result').innerText=eval(" & sJson & ").access_token;" access_token = oElm.innerText End If End If End With End If getAccessToken = access_token End Function 'IEの表示待ち処理 Private Sub waitIE(ByRef oIE As Object) While oIE.readyState <> 4 DoEvents Wend End Sub |