VBAでAPI（OAuth2.0の認可コードフロー）を叩く

はじめに

この記事ではAPIを叩く時にOAuth2.0の認可コードフローの対応が必要なケースについて、純粋にVBAのみで対応する実装をご紹介します。

※今回は GoogleAPI で公開個人情報をDebug.printするだけの単純な例を取り上げています。

実装の概要

今回、OAuth2.0の認可コードフローに対応するためにブラウザの操作を行います。

ブラウザの操作といえばSeleniumが思い浮かぶかと思いますが、インストールが必要であったり、ChromeのバージョンアップでWebDriverの更新対応が必要であったり、何かと工数がかかります。

そのため今回の実装では、そういった工数が一切かからず Selenium も WebDriver も不要でブラウザ操作ができる 自己開発ライブラリである ZeroInstall BrowserDriver for VBA を使用します。

※ライブラリといってもインストールは一切必要ありません。
　クラス群をExcelファイルにインポートするだけで使用可能です。

事前準備

①ZeroInstall BrowserDriver for VBA をダウンロードし、全てのクラスファイルをExcelファイルのVBAプロジェクトにドラッグ＆ドロップでインポートする。

参考：別の方が導入方法についてご紹介してくださった記事

②グーグル側でのAPI利用設定を行う。

参考：https://blog.shinonome.io/google-api/ 手順１の箇所
参考：https://developers.google.com/identity/protocols/oauth2/web-server?hl=ja#prerequisites

※「承認済みのRedirect URI」欄には https://localhost を設定してください。

実装詳細

＜コード内のコメントで大きく分けて１．～ ５．に分けてあります。＞

vba : API（OAuth2認可コードフロー）で公開個人情報を表示するmainコード

Public Sub DebugPrint_PersonlInfomation_ByAPI_OAuth2()

    ' 自作ライブラリのクローム操作クラス。 ブラウザ操作以外の機能として、認可コードフローで必要なパラメータ値の生成に必要な機能も持つ。
    Dim driver As IWebDriver: Set driver = New ChromeDriver
    
'１．【API必要情報設定】 APIをOAuthで叩くのに必要なパラメーター情報を事前に用意し、辞書に格納する。
    Dim apiConfig As Object: Set apiConfig = createObject("Scripting.Dictionary")
    
    apiConfig.Add "auth_endpoint", "https://accounts.google.com/o/oauth2/v2/auth"
    apiConfig.Add "token_endpoint", "https://oauth2.googleapis.com/token"
    apiConfig.Add "client_id", "" 'ご自身のクライアントIDを指定
    apiConfig.Add "client_secret", "" 'ご自身のクライアントシークレットを指定
    
    ' Redirect URIの指定。（ローカルホストで認可コードを受取。事前にGoogleAPI側の設定画面でも指定しておく。）
    apiConfig.Add "redirect_uri", driver.EncodeURIConpornent("https://localhost")
    ' scopeの指定（今回は例として公開個人情報の取得権限を設定）
    apiConfig.Add "scope", driver.EncodeURIConpornent("https://www.googleapis.com/auth/userinfo.profile")
    ' CSRF対策用のオプションパラメーター。
    ' 自作ライブラリクラスの以下メソッドクラスで16文字のランダム文字列を設定
    apiConfig.Add "state", driver.GetURLSafeRundomString(16)
    ' PKCE(認可コード横取り・盗聴対策）用のオプションパラメーター。
    ' 自作ライブラリクラスの以下メソッドでランダム文字列生成およびSHA256Base64URLエンコード値を設定
    apiConfig.Add "code_veryfire", driver.GetURLSafeRundomString(43) ' RFC 7636で長さは最低43~最大128文字と定義。
    apiConfig.Add "code_challenge", driver.GetBase64URLEncodedSHA256(apiConfig("code_veryfire"))
    

'２．【認可コード取得】 認可エンドポイントへ認可リクエストを送信し、認可コードを取得。
    Dim authCode As String: authCode = GetAuthCode(driver, apiConfig)
    ' 取得失敗の場合は終了
    If authCode = "" Then End

'３．【トークン取得】 トークンエンドポイントへトークンリクエストを送信し、トークンを取得
    ' トークンの情報を格納するための辞書
    Dim tokenInfoDic As Object: Set tokenInfoDic = createObject("Scripting.Dictionary")
    Set tokenInfoDic = GetToken(authCode, apiConfig, tokenInfoDic)
    ' 取得失敗の場合は終了
    If tokenInfoDic("response_status") <> 200 Then End
    
    Debug.Print tokenInfoDic("access_token")
    
    '===============
'4. 【API操作】 トークンを元にAPIを叩き公開個人情報を表示
    Dim resourceEndPoint As String: resourceEndPoint = "https://www.googleapis.com/oauth2/v1/userinfo"
    DebugPrintPersonalInfomationByAPI resourceEndPoint, tokenInfoDic("access_token")
    '===============
    
'5．【トークン更新】 別のAPIを叩く前にトークンの有効期限を知らべ切れていたら､トークンの更新
    If IsAccessTokenValid(tokenInfoDic) = False Then
        Set tokenInfoDic = GetNewTokenByRefresh(apiConfig, tokenInfoDic)
        If tokenInfoDic("response_status") <> 200 Then End
        
        Debug.Print tokenInfoDic("access_token")
    End If
    
End Sub

１．【API必要情報設定】で設定する scope について
参考：https://developers.google.com/identity/protocols/oauth2/scopes?hl=ja

mainコードの ２．【認可コード取得】 で呼ばれる関数

vba : 認可コード取得

Private Function GetAuthCode(driver As IWebDriver, apiConfig As Object) As String
    ' 認可リクエストのパラメーター用文字列を生成
    Dim param As String
    param = "?response_type=code" & _
                 "&client_id=" & apiConfig("client_id") & _
                 "&redirect_uri=" & apiConfig("redirect_uri") & _
                 "&scope=" & apiConfig("scope") & _
                 "&state=" & apiConfig("state") & _
                 "&code_challenge=" & apiConfig("code_challenge") & _
                 "&code_challenge_method=S256" & _
                 "&access_type=offline" & _
                 "&prompt=consent"
    
    '自作ライブラリクラスによるクローム操作により、認可エンドポイントへ認可リクエスト送信
    driver.OpenURL (apiConfig("auth_endpoint") & param)
    
    ' 認可サーバから認可コードが戻るまでループ
    Dim timeCount As Long
    Do While True
        ' 認可コードはリダイレクトURIのクエリ文字列のcode=の値として返ってくるため、URLに"code="が含まれるかどうかで戻り判定
        ' ※自作ライブラリクラスの以下プロパティで現在のURLの値を取得可能
        If InStr(driver.URL, "code=") > 0 Then Exit Do
        
        ' ※自作ライブラリクラスの以下メソッドで1秒スリープ
        driver.SleepByWinAPI 1000
        timeCount = timeCount + 1
        '30秒待っても返ってこない場合、ユーザー認証せずとみなす
        If timeCount > 30 Then GoTo ErrorExit
    Loop
    
    ' CSRFパラメータ（state）がクエリ文字列内に含まれて返ってくるため、リクエストで送信したstateと相違ないかチェック
    ' ※自作ライブラリクラスの以下メソッドの引数にkeyを与えるとURLのクエリ文字列からそのKeyに対する値を取得可能。
    If apiConfig("state") <> driver.GetValueFromQueryString("state") Then GoTo ErrorExit
    
    ' 認可コードがクエリ文字列内に含まれて返ってくるためURLのクエリ文字列より取得し、戻り値設定
    GetAuthCode = driver.GetValueFromQueryString("code")
    
    ' ブラウザを閉じる
    driver.CloseWindow
    Exit Function

ErrorExit:
    If timeCount > 30 Then
        MsgBox "ユーザーが認可せず30秒経過!"
    Else
        MsgBox "Stateがリクエストの値と異なる！"
    End If
    driver.CloseWindow
    GetAuthCode = ""
End Function

mainコードの 3．【トークン取得】 で呼ばれる関数

vba : アクセストークンの取得

Private Function GetToken(authCode As String, apiConfig As Object, tokenInfoDic As Object) As Object
    'POSTメソッドのbody
    Dim body As String
    body = "grant_type=authorization_code" & _
               "&code=" & authCode & _
               "&client_id=" & apiConfig("client_id") & _
               "&client_secret=" & apiConfig("client_secret") & _
               "&redirect_uri=" & apiConfig("redirect_uri") & _
               "&code_verifier=" & apiConfig("code_veryfire")

    Set GetToken = GetHTTPResponseAndSetValueToDictionary(apiConfig, body, tokenInfoDic)
End Function

※内部で呼出している関数

vba : HTTPリクエスト送信およびレスポンス受信（トークンの更新でも使用）

Private Function GetHTTPResponseAndSetValueToDictionary(apiConfig As Object, body As String, tokenInfoDic As Object) As Object
    'AccessToken取得リクエスト。取得成功した場合、情報を辞書へ設定
    With createObject("MSXML2.ServerXMLHTTP.6.0")
        .Open "POST", apiConfig("token_endpoint"), False
        .setRequestHeader "Content-Type", "application/x-www-form-urlencoded;charset=UTF-8"
        .send body
        
        tokenInfoDic("response_status") = .Status
        If .Status = 200 Then
            Set tokenInfoDic = SetValueTo(tokenInfoDic, .responseText)
        Else
            Debug.Print "Response Status：" & .Status & "：トークン取得失敗"
        End If
    End With
    
    Set GetHTTPResponseAndSetValueToDictionary = tokenInfoDic
End Function

※内部で呼出している関数

vba : アクセストークンの情報を辞書に設定（トークンの更新でも使用）

Private Function SetValueTo(tokenInfoDic As Object, json As String) As Object
    ' 自作ライブラリに含まれるjsonからKeyを指定して値を取得するクラス
    Dim jsonHandler As a2_JSONHandler: Set jsonHandler = New a2_JSONHandler
    
    ' 自作ライブラリクラスの以下メソッドでjson文字列をparseしてからstringifyして取得する。
    ' 正常なjson文字列であれば不要な処理だが、今回のjson文字列には必要な場合あり。
    json = jsonHandler.GetParsedAndStringifiedJsonString(json)
    ' 補足：id_tokenが含まれるとその値はJWTの形式。
    ' それが含まれるとなぜか一度parseしてからstringifyしないと、正常なJSONとして認識されないため処理
    ' 恐らくJWTに含まれる”.”が原因だと思うが詳細は不明
    
    ' 自作ライブラリクラスの以下メソッドに引数としてjson文字列とkeyを与えると、そのjsonからkeyに対する値を取得できる。
    tokenInfoDic("access_token") = jsonHandler.GetValue(json, ("access_token"))
    tokenInfoDic("expires_in") = jsonHandler.GetValue(json, ("expires_in"))
    tokenInfoDic("get_date") = Now()
    tokenInfoDic("expire_date") = DateAdd("s", tokenInfoDic("expires_in"), Now())
    
    Dim refresh_token As String: refresh_token = jsonHandler.GetValue(json, ("refresh_token"))
    If refresh_token <> "" Then tokenInfoDic("refresh_token") = refresh_token
    
    Set SetValueTo = tokenInfoDic
End Function

mainコードの ４．【API操作】 で呼ばれる関数

vba : 公開個人情報取得APIを叩き、レスポンス(JSON)から値を取得し表示する

Public Sub DebugPrintPersonalInfomationByAPI(resourceEndPoint As String, accessToken As String)
    With createObject("MSXML2.ServerXMLHTTP.6.0")
        .Open "GET", resourceEndPoint, False
        ' Authorizationヘッダにアクセストークンを設定
        .setRequestHeader "Authorization", "Bearer " & accessToken
        .send
        
        If .Status = 200 Then
            Dim json As String: json = .responseText
            Dim jsonHandler As a2_JSONHandler: Set jsonHandler = New a2_JSONHandler
            Debug.Print "フルネーム：" & jsonHandler.GetValue(json, "name")
            Debug.Print "名：" & jsonHandler.GetValue(json, "given_name")
            Debug.Print "性：" & jsonHandler.GetValue(json, "family_name")
            Debug.Print "画像：" & jsonHandler.GetValue(json, "picture")
            Debug.Print "ロケール：" & jsonHandler.GetValue(json, "locale")
            
        Else
            Debug.Print "Response Status：" & .Status & "：API失敗"
        End If
    End With
End Sub

メインコードの ５．【トークン更新】 で呼ばれる関数

vba : アクセストークンの有効期限チェック

Public Function IsAccessTokenValid(tokenInfoDic As Object) As Integer
    '有効期限が5分以下になったら無効と判定
    If DateDiff("n", Now(), tokenInfoDic("expire_date")) >= 5 Then
        IsAccessTokenValid = True
    Else
        IsAccessTokenValid = False
    End If
End Function

vba : アクセストークンの更新

Public Function GetNewTokenByRefresh(apiConfig As Object, tokenInfoDic As Object) As Object
    'POSTメソッドのbody
    Dim body As String
    body = "grant_type=refresh_token" & _
               "&refresh_token=" & tokenInfoDic("refresh_token") & _
               "&client_id=" & apiConfig("client_id") & _
               "&client_secret=" & apiConfig("client_secret")
    
    Set GetNewTokenByRefresh = GetHTTPResponseAndSetValueToDictionary(apiConfig, body, tokenInfoDic)
End Function

実行時の挙動

メインコードを実行すると、以下挙動となります。
・ブラウザが立ち上がる
・認可コード取得リクエスト送信

・ユーザーへ認可を求める画面が表示されるので、ユーザーとして認可する
　※ここはユーザとしてブラウザ上で認可する操作をしてください。

・ブラウザに「このサイトにアクセスできません」と表示される。
　※意図通りの挙動のため問題なし

・ブラウザが閉じる
・アクセストークン取得。
・APIを叩き公開個人情報を取得しDebug.printで表示

補足

コードの説明はコメントに全て記載しておりますのでコメントをご参照ください。

ちなみにライブラリを初めて使用する際にのみ「ダウンロード」フォルダ内に「ブラウザ操作用のユーザープロフィール」フォルダが自動作成されます。

※作成された「ブラウザ操作用のユーザープロフィールフォルダ」は削除しても問題ないのですが、自作ライブラリの実行時には必要になるので、削除後にコードを再実行するとまた自動作成されます。