Google API 第12回

投稿者: | 2015年6月18日
0件のコメント

今回は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にそれぞれスコープがあります。

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を自動で開き認証用コードを取得する方法を取ります。
下記の手順で説明します。
１．認証用URLを作成
２．Internet Explorerで認証用URLにアクセス
３．ログイン処理
４．承認処理
５・認証用コード取得処理

１．認証用URLの作成
認証用URLはベースとなるURL(https://accounts.google.com/o/oauth2/auth?)に
client_id、response_type、redirect_uri、scopeのパラメータを足したものです。

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

２．Internet Explorerで認証用URLにアクセス
readyStateが4になるまで待ち、全データ読込完了状態します。
この処理をしないとエラーが発生します。

Dim oIE As Object
Set oIE = CreateObject("InternetExplorer.Application")
With oIE
.Visible = False 'IEのブラウザを表示するか否か
.Navigate sUrl
While oIE.readyState <> 4
DoEvents
Wend

３．ログイン処理
ログイン処理では複数のアカウントがある時とログインしていない時の処理をします。

アカウントが１つの時の処理

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

複数のアカウントがある時の処理
ここでは該当するアカウントがあっても処理が複雑になるので画面をスルーしています。

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アカウントとパスワードの値を入力しサインインします。

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

４．承認処理
承認を求められるので承認を行います。

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

５．認証用コード取得処理
認証用コードが表示されるので認証用コードを取得します。

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の通信が可能になります。

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の通信ができるようになります。

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通信するためのコードです。

'アカウント等の定義
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
    
    '１．認証用URLの作成
    sUrl = "https://accounts.google.com/o/oauth2/auth?" & _
          "client_id=" & client_id & "&" & _
          "response_type=code" & "&" & _
          "redirect_uri=" & redirect_uri & "&" & _
          "scope=" & scope
  
    '２．Internet Explorerで認証用URLにアクセス
    Set oIE = CreateObject("InternetExplorer.Application")
    With oIE
        .Visible = False 'IEのブラウザを表示するか否か
        .Navigate sUrl
        Call waitIE(oIE)
    
        '３．アカウントが１つの時の処理
        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
        
        '３．複数のアカウントがある時の処理
      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
        
        '３．ログインしていない時の処理
        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
        
        '４．承認処理
        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
        
        '５．認証用コード取得処理
        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