2021年10月20日 / 最終更新日時 : 2024年11月9日 officeの杜 msoffice

VBAでOAuth2.0認証 - Windows11対応版

Windows11が登場し、IE11の廃止がハッキリと名言された為、Windows11上ではIE11は使えず、一応EdgeでのIE11モードがあるという状態になっています（あくまでも一時的な措置であり、Chromium EdgeやChromeへ移行する為のもの）。未だに日本の東証一部上場企業の中に社内標準ブラウザにIE11を指定してる企業があることに驚きですが。

しかし、一方でVBAでのスクレイピングやブラウザ操作、OAuth2.0認証の実行はこれまでのコードはIE11を基本としてきた為、VBAでREST APIを叩く一番最初に関門が出来てしまいました。これを突破し、Windows11上でもVBAからOAuth2.0認証できないか？にチャレンジしてみます。

今回利用するモジュールやファイル

いくつかのパターンでチャレンジをしてみている為、上記のモジュールの全てが必要なわけではありません。また、過去のIE11でOAuth2.0認証を行うコードについては、以下のエントリーを参照してください。Access Tokenの取得やExpire時のrefresh tokenを使った更新、REST APIを叩くコードは、依然として利用可能です（一部問題があります）。

今回はBox APIを叩いてみますが、Box APIの設定については本エントリーでは扱いません。

※VBAの参照設定にて、Microsoft Scripting Runtimeへの参照がオンになっている必要があります。

VBAからBox APIを叩いてみる - 準備編

新方式が登場しました

IE11の廃止に伴い、SeleniumやNode.jsやらといった手段を使わず、またPuppeteerと同様の手法（CDPを叩く）でVBAとEdge/ChromeのみでOAuth2.0認証する手段が登場しました。スクレイピングも可能になっています。以下のエントリーを参考にしてみてください。この手法は最も制限が無く、もっともすぐれた選択肢になると思います。

VBAでOAuth2.0認証 - 新方式を試してみた

Web Driverを使わない手法

本来、VBAでウェブを操作する場合は、操作するウェブブラウザに対応したWebDriverをインストールし、それを元にSelenium Basicなどで操作をするのが基本ですが、そもそもSelenium Basicなどがインストール出来ない環境が、なぜか日本企業の場合多いです（原因は全て情シス）。故に、WebDriverも使えないケースがあり、それだと詰んでしまいます。

CodeProject（要ログイン）のサイトにて有志の方が作成されたクラスライブラリを使う事でVBAから直接Chrome DevTools Protocolを叩いて操作するようです。

事前準備

掲示されてるZIPをダウンロードする
Excelを起動し、開発 => Visual Basicを開く（開発タブが表示されていない場合はこちらを参考に）
プロジェクトの欄にて、右クリック⇒ファイルのインポートをクリック
1.のclsおよびbasファイルをインポートする
一つ空の標準モジュールを追加しておきます。ここにコードを記述します。
名前を付けて保存でブックをxlsm形式で保存します。

これで利用できるようになりました。

認証用コード

今回は、こちらのサイトのコードをお借りしつつ、二段階認証があるサイトであるので、以前のコードを組み合わせて、Access Tokenを取得する前のAuthcodeの取得までを実装しています。

ただし、このクラスはEdgeを終了させるメソッドが無い点と、いちいちコマンドプロンプトが邪魔してくるのでちょっと現実で利用するには面倒だなと感じました。

Option Explicit

'OAuth認証用
Private Const client_id As String = "クライアントIDを記入する"
Private Const client_secret As String = "クライアントシークレットを入力する"
Private Const oauthurl As String = "https://account.box.com/api/oauth2/authorize?"
Private Const tokenurl As String = "https://api.box.com/oauth2/token"
Private Const grant_type As String = "authorization_code"
Private Const redirecturl As String = "リダイレクトURLを記入する"

'Box APIの認証を行う
Public Function boxAuthorization()
    'iniファイルからidとpassを読み込み
    Dim loginid As String
    Dim passwd As String
    
    loginid = IniRead("USER", "LOGINID", "")
    passwd = IniRead("USER", "PASSWD", "")

    'Chrome DevTool操作用変数
    Dim objBrowser As clsEdge
    Set objBrowser = New clsEdge
    Dim locationurl As String
    
    'Edgeを操作する
    With objBrowser
        '認証のURLを開く
        .start
        .attach ""
        .navigate oauthurl & "response_type=code&client_id=" & client_id & "&state=authenticated"
      
        '開かれるまでウェイト
        WaitBrowser objBrowser
        
        'ログインIDとPWを入力
        '.jsEval "alert('" & loginid & "')"
        .jsEval "document.getElementsByName('login')[0].value = '" & loginid & "'"
        .jsEval "document.getElementsByName('password')[0].value = '" & passwd & "'"

        'ログイン実行
        .jsEval "document.getElementsByName('login_submit')[0].click()"
        
        '開かれるまでウェイト
        WaitBrowser objBrowser
        
        'リダイレクトURLになるまで待機
        locationurl = objBrowser.jsEval("location.href")
        
        '認証が実行されるまで待機
        While InStr(LCase(locationurl), redirecturl) < 1
            locationurl = objBrowser.jsEval("location.href")
            DoEvents
        Wend
    End With

    '取得したコードからcode=以下を取得する
    Dim authcode As String
    authcode = Mid(locationurl, InStr(locationurl, "code=") + 5)
    Debug.Print authcode
    
End Function

'ブラウザにウェイトを掛ける
Private Sub WaitBrowser(ByVal objBrowser As Object)
    Do While objBrowser.jsEval("document.readyState") <> "complete"
        DoEvents
    Loop
End Sub

Option Explicit

'OAuth認証用

Private Const client_id As String = "クライアントIDを記入する"

Private Const client_secret As String = "クライアントシークレットを入力する"

Private Const oauthurl As String = "https://account.box.com/api/oauth2/authorize?"

Private Const tokenurl As String = "https://api.box.com/oauth2/token"

Private Const grant_type As String = "authorization_code"

Private Const redirecturl As String = "リダイレクトURLを記入する"

'Box APIの認証を行う

Public Function boxAuthorization()

'iniファイルからidとpassを読み込み

Dim loginid As String

Dim passwd As String

loginid = IniRead("USER", "LOGINID", "")

passwd = IniRead("USER", "PASSWD", "")

'Chrome DevTool操作用変数

Dim objBrowser As clsEdge

Set objBrowser = New clsEdge

Dim locationurl As String

'Edgeを操作する

With objBrowser

'認証のURLを開く

.start

.attach ""

.navigate oauthurl & "response_type=code&client_id=" & client_id & "&state=authenticated"

'開かれるまでウェイト

WaitBrowser objBrowser

'ログインIDとPWを入力

'.jsEval "alert('" & loginid & "')"

.jsEval "document.getElementsByName('login')[0].value = '" & loginid & "'"

.jsEval "document.getElementsByName('password')[0].value = '" & passwd & "'"

'ログイン実行

.jsEval "document.getElementsByName('login_submit')[0].click()"

'開かれるまでウェイト

WaitBrowser objBrowser

'リダイレクトURLになるまで待機

locationurl = objBrowser.jsEval("location.href")

'認証が実行されるまで待機

While InStr(LCase(locationurl), redirecturl) < 1

locationurl = objBrowser.jsEval("location.href")

DoEvents

Wend

End With

'取得したコードからcode=以下を取得する

Dim authcode As String

authcode = Mid(locationurl, InStr(locationurl, "code=") + 5)

Debug.Print authcode

End Function

'ブラウザにウェイトを掛ける

Private Sub WaitBrowser(ByVal objBrowser As Object)

Do While objBrowser.jsEval("document.readyState") <> "complete"

DoEvents

Loop

End Sub

ログイン用のIDとPWは、setting.iniファイルから取得させています。
自動でログイン後はリダイレクトURLのサイトに来るまで、Edgeは待機させておきます。
リダイレクトURLのページまで来たら、URLに含まれてるAuthcodeを取り出して終了です。これをAccess Tokenと交換する別の関数に食わせます。
Edgeが起動した状態のまま上記コードを実行してしまうと、動作が止まります。
基本操作はJavaScriptを実行してブラウザ内の要素を操作したり、alertを出したりなどの命令を実行する形です。
Boxのログイン画面は各要素にはName属性がついてるので、これを元に入力やクリックを行っています。
Edgeのクローズについては、clsEdgeに起動のコードがあるので、ここでpidを取得しておいて、クローズ時に利用すればいける気がする

WebDriverを利用する手法

事前準備

以下は、WebDriverを利用してEdgeやChromeを操作する方法になります。よって、事前にWebDriverのインストールが必要です。ただし、WebDriverを使った手法は、ChromiumのバージョンとWebDriverのバージョンを合わせる必要があるため、ブラウザのバージョンアップ時には必ず、WebDriverもアップデートが必要になるなど、こちらのサイトのVBAのように、更新をメンテするコードが必要になるかもしれません。

今回はEdge用のドライバを利用してみます。

Edgeを起動し、「…」⇒ Microsoft Edgeについてを開く
Edgeのバージョンが出てくるので、これを控えておく（今回は、94.0.992.50でした）
WebDriverを公式サイトから、バージョンの一致するものをダウンロード。今回は、x86を選びました。
3.を解凍する
4.をドキュメントフォルダの直下にでも配置する（フォルダ名はedgedriver_win32）
msedgedriver.exeまでのフルパスを取得しておく

これで準備は完了です。

図：ブラウザのバージョンと合わせるのが肝

TinySeleniumVBAを使ってみる

Selenium Basicを利用せずにWebDriverを直接操作するコードを使いやすい形でラッピングしてくれたライブラリです。Githubにて公開されており、作者様の説明はQiitaにて公開されています。WebDriverはドキュメントフォルダにでも解凍するだけで良いので、Seleniumのようにいわゆるインストーラを使っての作業が無いため、管理者権限がなくても利用できる点が大きいです。

ただし現在は必要最小限のみで、ログインまでしか実装出来ません。自身でChrome Devtool Protocolを解析して実装するならともかく、現状OAuth2.0の認証に必要な「現在のURLを取得」「現在のブラウザの読み込み状況」の２つが無いため、OAuth2.0ではちょっと使えません。

※仕組みはChromiumのPortに対して、httpアクセスでPOSTやGETで投げて操作してるようです。

事前準備

Githubで公開されてるファイルを入手し、Excelに取り込んで利用できるようにします。

Githubで公開されてるZIPファイルをダウンロードする
Excelを起動し、開発 => Visual Basicを開く（開発タブが表示されていない場合はこちらを参考に）
プロジェクトの欄にて、右クリック⇒ファイルのインポートをクリック
clsファイルが2つあるので、全てインポートする。JsonConverter.basも入れておきましょう。
一つ空の標準モジュールを追加しておきます。ここにコードを記述します。
名前を付けて保存でブックをxlsm形式で保存します。

これで利用できるようになりました

※なぜか、clsをインポートすると、標準モジュールとして認識されてしまい、これだとコードが動かないので、２つのclsファイルについては以下の処理をしました。

空のクラスモジュールを追加
cls内のコードをコピペ（WebDriverとWebElementの2つの名前に変えておく）
冒頭のmultiuseのコードは不要なので削る

これで、New WebDriverの部分でエラーが出ることなく、Edge操作ができるようになりました。

図：インポートが完了したら使える

認証用コード

認証用コードのwdriverには前述のWebDriverであるmsedgedriver.exeへのフルパスを入れておきます。

'Box APIの認証を行う
Public Function boxAuthorization2()
    'iniファイルからidとpassを読み込み
    Dim loginid As String
    Dim passwd As String
    
    loginid = IniRead("USER", "LOGINID", "")
    passwd = IniRead("USER", "PASSWD", "")

    'WebDriverを起動する
    Dim Driver As New WebDriver
    Driver.Edge wdriver
    
    'ブラウザを起動する
    Driver.OpenBrowser

    '認証URLを開く
    Driver.Navigate oauthurl & "response_type=code&client_id=" & client_id & "&state=authenticated"
    
    'IDとpasswdを入力
    Dim loginInput, passInput
    Set loginInput = Driver.FindElement(By.Name, "login")
    Set passInput = Driver.FindElement(By.Name, "password")
    
    loginInput.SetValue loginid
    passInput.SetValue passwd
    
    'ログイン実行
    Driver.FindElements(By.Name, "login_submit")(0).Click

    'ブラウザを閉じる
    Driver.CloseBrowser
    Driver.Shutdown

End Function

'Box APIの認証を行う

Public Function boxAuthorization2()

'iniファイルからidとpassを読み込み

Dim loginid As String

Dim passwd As String

loginid = IniRead("USER", "LOGINID", "")

passwd = IniRead("USER", "PASSWD", "")

'WebDriverを起動する

Dim Driver As New WebDriver

Driver.Edge wdriver

'ブラウザを起動する

Driver.OpenBrowser

'認証URLを開く

Driver.Navigate oauthurl & "response_type=code&client_id=" & client_id & "&state=authenticated"

'IDとpasswdを入力

Dim loginInput, passInput

Set loginInput = Driver.FindElement(By.Name, "login")

Set passInput = Driver.FindElement(By.Name, "password")

loginInput.SetValue loginid

passInput.SetValue passwd

'ログイン実行

Driver.FindElements(By.Name, "login_submit")(0).Click

'ブラウザを閉じる

Driver.CloseBrowser

Driver.Shutdown

End Function

ログイン実行まではこのライブラリでうまく実行可能です。
問題はそこから先は、CDPを操作する為のメソッドが足りない為、現時点ではOAuth2.0認証には使えません。

Selenium Basicを使ってみる

もっとも広く利用されてるEdgeやChromeを操縦する手法ですが、Selenium Basicは管理者権限がなければ通常はインストールが出来ない為、通常の企業のクライアントPCの場合は、情報システムにお伺いを立てて許可を得てインストールが必要になってしまいます（後述に裏技あり）。WebDriverも必要になります。この辺りのセットアップ方法は、以前のエントリーでも紹介しました。

ただ、Selenium Basic自体は既に2016年に開発がストップしており、WebDriverの入れ替えだけで延命してる状態であるため、果たしてどこまで使えるのか？という不安が残るものです。

VBAで他のアプリケーションを操作する

事前準備

SeleniumBasicのセットアップは簡単。以下の手順でセットアップをします。

配布元に行き、Release Pageへ入る
最新版をクリックしてダウンロード
ダウンロードされたインストーラを起動して適当に進める。
途中、Web Driverのインストールに関する項目がでるけれど全てそのままインストール
完了したらインストール自体は完了。

ただし、このWeb Driverが最新とは限らないので、以下の手順で最新版にすげ替える。

WebDriverを公式サイトから、バージョンの一致するものをダウンロード。今回は、x86を選びました。
3.を解凍する。
Explorerを起動し、パスの部分に「C:\Users\ユーザ名\AppData\Roaming\SeleniumBasic」を入れて移動する
3.で解凍されたmsedgedriver.exeをedgedriver.exeにリネームして、3.のフォルダに上書きします
コードを書くための空の標準モジュールを追加する
.net Framework 3.5が必要なので、3.のscriptsフォルダ内にあるStartEdge.vbsを実行するか？手動でインストールしておく
6.をインストール完了したら一旦OSを再起動する（再起動しないとオートメーションエラーで起動しません）

これで完了です。

図：インストール自体はとても簡単

図：ブラウザとドライバのバージョンが違うとエラーが出る

認証用コード

使用するには事前に「Selenium Type Library」を参照設定で入れておく必要性があります。インストールした後であれば参照設定のリストに出てくるはずです。チェックを入れておきましょう。コードの中で事前バインディングではなく、実行時バインディングで使う場合には、以下のようなコードになります。今回のサンプルは、実行時バインディングで記述してあります。

Dim selenium as Object
Set selenium = CreateObject("Selenium.WebDriver")

1 2	Dim selenium as Object Set selenium = CreateObject("Selenium.WebDriver")

図：事前バインディングの場合参照設定をする

'Box APIの認証を行う
Public Function boxAuthorization3()
    'ライブラリを呼び出す
    Dim driver As New selenium.EdgeDriver
    
    'iniファイルからidとpassを読み込み
    Dim loginid As String
    Dim passwd As String
    Dim locationurl As String
    
    loginid = IniRead("USER", "LOGINID", "")
    passwd = IniRead("USER", "PASSWD", "")

    With driver
        '認証用ページを開く
        .Start
        .Get oauthurl & "response_type=code&client_id=" & client_id & "&state=authenticated"

        'ログイン情報を入力する
        .FindElementByName("login").SendKeys (loginid)
        .FindElementByName("password").SendKeys (passwd)
        
        'クリックしてログイン処理
        .FindElementByName("login_submit").Click
        .Timeouts.ImplicitWait = 10000
        
        'リダイレクトURLになるまで待機
        locationurl = driver.url
        
        '認証が実行されるまで待機
        While InStr(LCase(locationurl), redirecturl) < 1
            locationurl = driver.url
            DoEvents
        Wend
        
        '取得したコードからcode=以下を取得する
        Dim authcode As String
        authcode = Mid(locationurl, InStr(locationurl, "code=") + 5)
        Debug.Print authcode

        'Edgeを終了する
        .Close
    End With
End Function

'Box APIの認証を行う

Public Function boxAuthorization3()

'ライブラリを呼び出す

Dim driver As New selenium.EdgeDriver

'iniファイルからidとpassを読み込み

Dim loginid As String

Dim passwd As String

Dim locationurl As String

loginid = IniRead("USER", "LOGINID", "")

passwd = IniRead("USER", "PASSWD", "")

With driver

'認証用ページを開く

.Start

.Get oauthurl & "response_type=code&client_id=" & client_id & "&state=authenticated"

'ログイン情報を入力する

.FindElementByName("login").SendKeys (loginid)

.FindElementByName("password").SendKeys (passwd)

'クリックしてログイン処理

.FindElementByName("login_submit").Click

.Timeouts.ImplicitWait = 10000

'リダイレクトURLになるまで待機

locationurl = driver.url

'認証が実行されるまで待機

While InStr(LCase(locationurl), redirecturl) < 1

locationurl = driver.url

DoEvents

Wend

'取得したコードからcode=以下を取得する

Dim authcode As String

authcode = Mid(locationurl, InStr(locationurl, "code=") + 5)

Debug.Print authcode

'Edgeを終了する

.Close

End With

End Function

非常に正確に問題なくauthcodeが取得出来ます。
タイムアウトの設定や現在のURLの取得も非常に簡単です。
終了したら、closeで閉じるだけ。後は、Access Tokenを取得する関数に食わせるだけ。
ヘッドレスモードで動かす事も可能ですが今回は認証ボタンは人間が押す必要があるため、途中でリダイレクトURLに来るまで待機させています。

SeleniumBasicを管理者権限無しでインストール

通常のインストーラでは、管理者権限の必要なディレクトリへのインストールが必要である点や、各種dllの登録が必要であるため、通常の企業で制限のある環境ではSeleniumBasicは使えませんでした。しかし、これを可能にする手段を考えた方がおり、インストール用のスクリプトを公開しています。

管理者権限無しでインストール手順は以下の通りです。

innoextractをダウンロード、解凍する
SeleniumBasicをsetupというディレクトリ作って入れておく
2.の中に入れたインストーラを掴んで、1.の中にあるinnoextract.exeにドラッグアンドドロップ
インストーラが分解されて、2.のディレクトリ内にappというフォルダができる
4.のフォルダが読み取り専用になってるので、これを解除しておく
最新のEdgeやChrome用のwebdriverのexeを4.のapp内のドライバに上書きする
こちらのスクリプトをテキストエディタに貼り付けて、install.cmdとして保存する
6.のスクリプトを4.のフォルダに入れて、実行する
ユーザのAppData¥Roaming¥SeleniumBasicに必要なファイルがコピーされ、ライブラリがレジストリに登録される
これでユーザ権限でSeleniumBasicを実行可能になる

図：インストールスクリプト実行中

図：きちんと参照先が変更されてる

WebDriverの自動更新

SeleniumBasicの弱点の一つである「WebDriverとブラウザのバージョンを一致させなければならない」点。EdgeやChromeが自動バージョンアップしてしまうと、Selenium Basicが動かなくなってしまいます。そのたびに手動でユーザが適合するWebDriverをダウンロードし、SeleniumBasicのフォルダに上書きコピーはかなりの手間です。

そこで、これを自動化するためのWebDriverManager-for-VBAがGithubにて公開されています。利用する為には以下の手順が必要です。

WebDriverManager-for-VBAのWebDriverManager4SeleniumBasic.basをダウンロードする
ExcelのVisual Basicを開き、1.のbasファイルをインポートする
今回は操作対象はEdgeであったので、Driver.startの部分をSafeOpen Driver, Edgeに書き換える
毎回バージョンチェックと自動ダウンロードでドライバを置き換えてから、SeleniumBasicが起動するようになります。

前述のユーザ権限でインストールを実行した場合には、第三引数にedgedriver.exeのパスを書くと書かれていますが、safeOpen関数に第三引数の受け口が無い状態なので、この場合は直接WebDriverPath関数のBrowserName.Edgeにあるパスを「AppData¥Roaming¥SeleniumBasic」に書き換えます。

書き換えた場合のコードは以下の通り。

Public Function boxAuthorization3()
    'ライブラリを呼び出す
    Dim Driver As New selenium.edgedriver

    'iniファイルからidとpassを読み込み
    Dim loginid As String
    Dim passwd As String
    Dim locationurl As String
    
    loginid = IniRead("USER", "LOGINID", "")
    passwd = IniRead("USER", "PASSWD", "")

    With Driver
        '認証用ページを開く
        SafeOpen Driver, Edge
        .Get oauthurl & "response_type=code&client_id=" & client_id & "&state=authenticated"

        'ログイン情報を入力する
        .FindElementByName("login").SendKeys (loginid)
        .FindElementByName("password").SendKeys (passwd)
        
        'クリックしてログイン処理
        .FindElementByName("login_submit").Click
        .Timeouts.ImplicitWait = 10000
        
        'リダイレクトURLになるまで待機
        locationurl = Driver.url
        
        '認証が実行されるまで待機
        While InStr(LCase(locationurl), redirecturl) < 1
            locationurl = Driver.url
            DoEvents
        Wend
        
        '取得したコードからcode=以下を取得する
        Dim authcode As String
        authcode = Mid(locationurl, InStr(locationurl, "code=") + 5)
        Debug.Print authcode


        'Edgeを終了する
        .Close
    End With
End Function

Public Function boxAuthorization3()

'ライブラリを呼び出す

Dim Driver As New selenium.edgedriver

'iniファイルからidとpassを読み込み

Dim loginid As String

Dim passwd As String

Dim locationurl As String

loginid = IniRead("USER", "LOGINID", "")

passwd = IniRead("USER", "PASSWD", "")

With Driver

'認証用ページを開く

SafeOpen Driver, Edge

.Get oauthurl & "response_type=code&client_id=" & client_id & "&state=authenticated"

'ログイン情報を入力する

.FindElementByName("login").SendKeys (loginid)

.FindElementByName("password").SendKeys (passwd)

'クリックしてログイン処理

.FindElementByName("login_submit").Click

.Timeouts.ImplicitWait = 10000

'リダイレクトURLになるまで待機

locationurl = Driver.url

'認証が実行されるまで待機

While InStr(LCase(locationurl), redirecturl) < 1

locationurl = Driver.url

DoEvents

Wend

'取得したコードからcode=以下を取得する

Dim authcode As String

authcode = Mid(locationurl, InStr(locationurl, "code=") + 5)

Debug.Print authcode

'Edgeを終了する

.Close

End With

End Function

Puppeteerを使う

概要

VBAにはSeleniumを使うSeleniumBasicライブラリがありますが、Puppeteerを使うためのライブラリは現在開発されていません。故に直接的にVBAからPuppeteerを使ってのChromeの操作は出来ません。しかし、Node.js + Puppeteer + pkgを利用して、Node.jsで作ったアプリをexe化したものであれば、VBAからexeを叩き、返り値を取得する事が可能です。以前似たようなものを以下のエントリーで作成しています。

今回はこの仕組でPuppeteerを動かしOAuth2.0認証を実行してみようと思います。

資格情報マネージャ読み書きプログラムをNode.jsで作成する

単一実行ファイルを作成する

Node.js 18よりSingle executable applicationsという機能が装備され、標準で単独実行ファイルが作成できるようになりました。結果pkgはプロジェクト終了となっています。よって、以下のエントリーの単一実行ファイルを作成するを参考に、Node18以降はexeファイルを作成することが可能です。

Puppeteerを使ってX(旧Twitter)へのポストを自動化する

認証用コード

VBA側

Sub credmanexe()
    'WSHの用意
    Dim WSH, wExec, sCmd As String, Result As String
    Set WSH = CreateObject("WScript.Shell")
    
    
    'iniファイルからidとpassを読み込み
    Dim loginid As String
    Dim passwd As String
    
    loginid = Chr(34) & IniRead("USER", "LOGINID", "") & Chr(34)
    passwd = Chr(34) & IniRead("USER", "PASSWD", "") & Chr(34)
    
    '認証URLを構築
    Dim url As String
    url = Chr(34) & oauthurl & "response_type=code" & Chr(38) & "client_id=" & client_id & Chr(38) & "state=authenticated" & Chr(34)

    'コマンドラインの組み立てと実行
    sCmd = ThisWorkbook.path & "\index-win.exe -u " & loginid & " -s " & passwd & " -g " & url
    Set wExec = WSH.Exec("%ComSpec% /c " & sCmd)
    
    'ステータスを見てループ
    Do While wExec.Status = 0
        DoEvents
    Loop
    
    '標準出力内容を取得
    Dim locationurl As String
    locationurl = wExec.StdOut.ReadAll
    
    '取得したコードからcode=以下を取得する
    Dim authcode As String
    authcode = Mid(locationurl, InStr(locationurl, "code=") + 5)
    Debug.Print authcode


    '終了処理
    Set wExec = Nothing
    Set WSH = Nothing

End Sub

Sub credmanexe()

'WSHの用意

Dim WSH, wExec, sCmd As String, Result As String

Set WSH = CreateObject("WScript.Shell")

'iniファイルからidとpassを読み込み

Dim loginid As String

Dim passwd As String

loginid = Chr(34) & IniRead("USER", "LOGINID", "") & Chr(34)

passwd = Chr(34) & IniRead("USER", "PASSWD", "") & Chr(34)

'認証URLを構築

Dim url As String

url = Chr(34) & oauthurl & "response_type=code" & Chr(38) & "client_id=" & client_id & Chr(38) & "state=authenticated" & Chr(34)

'コマンドラインの組み立てと実行

sCmd = ThisWorkbook.path & "\index-win.exe -u " & loginid & " -s " & passwd & " -g " & url

Set wExec = WSH.Exec("%ComSpec% /c " & sCmd)

'ステータスを見てループ

Do While wExec.Status = 0

DoEvents

Loop

'標準出力内容を取得

Dim locationurl As String

locationurl = wExec.StdOut.ReadAll

'取得したコードからcode=以下を取得する

Dim authcode As String

authcode = Mid(locationurl, InStr(locationurl, "code=") + 5)

Debug.Print authcode

'終了処理

Set wExec = Nothing

Set WSH = Nothing

End Sub

Node.jsのexeに渡す引数は前後をダブルコーテーションで括らないと削れるので、Chr関数でVBA特殊文字を加えてあります。
コマンドライン引数で、-u -s -gの３つのオプションを設定してるので、それぞれを引数で繋げる
処理が終わるとwExec.Statusが変化するので、それを検知する無限ループを用意しておく。
Node.js側からの返り値はconsole.logで最後に出力した内容がwExec.StdOut.ReadAllで取得できる（ここにはAuthcodeを含めたURLが入ってる）
最後にそこからAuthcodeのみを取り出す。

Node.js側

//使用するモジュール
const puppeteer = require('puppeteer-core');
var fs = require('fs');
const path = require("path");
var shell = require('child_process').exec;
var spawnSync = require('child_process').spawnSync;
const commandLineArgs = require('command-line-args');

//edge/chromeのパスを取得（ユーザ権限インストール時）
const userHome = process.env[process.platform == "win32" ? "USERPROFILE" : "HOME"];
var kiteipath = "C:\\Program Files (x86)\\Google\\Chrome\\Application\\chrome.exe";
var temppath = path.join(userHome, "AppData\\Local\\Google\\Chrome\\Application\\chrome.exe");
var edgepath = "C:\\Program Files (x86)\\Microsoft\\Edge\\Application\\msedge.exe";
 
//chrome場所判定
if (fs.existsSync(kiteipath)) {
	chromepath = kiteipath
} else {
	if (fs.existsSync(temppath)) {
	  chromepath = temppath;
	} else {
	  //Chromium Edgeの場合に対応
	  if(fs.existsSync(edgepath)){
		  chromepath = edgepath;
	  }else{
		  //IEを起動してChromeのインストールを促す　　　
		  shellexec('start "" "iexplore" "https://www.google.co.jp/chrome/"')
		  return;
	  }
	}
}

//コマンドライン引数を取得
//コマンドラインオプションを構築
const optionDefinitions = [
	{
	  name: 'userid',
	  alias: 'u',
	  type: String
	},
	{
	  name: 'passwd',
	  alias: 's',
	  type: String
	},
	{
	  name: 'geturl',
	  alias: 'g',
	  type: String
	}
];
const args = commandLineArgs(optionDefinitions);

//puppeteer実行
main();

//puppeteerメイン関数
async function main() {
	const browser = await puppeteer.launch({
		headless: false,
		executablePath: chromepath,
		ignoreDefaultArgs: ["--guest",'--disable-extensions','--start-fullscreen','--incognito',],
		slowMo:100,
	});

	//pageを定義
    const page = await browser.newPage()
    const navigationPromise = page.waitForNavigation()

	//ログインページを開く
    await page.goto(args.geturl)
    await page.setViewport({ width: 1300, height: 900 })
    await navigationPromise

	//IDとパスワードを入力
	var userid = args.userid;
	var pw = args.passwd;

	await page.type('#login', userid)
	await page.type('#password', pw)
	
	//ログイン実行
	await page.waitForSelector('.container > .form > .field_set > .login_submit_div > .btn')
	await page.click('.container > .form > .field_set > .login_submit_div > .btn')
	await navigationPromise

	//認証実行
	await page.waitForSelector('#consent_form > #login_content > .login_submit_div > #consent_accept_button > .submit')
	await page.click('#consent_form > #login_content > .login_submit_div > #consent_accept_button > .submit')
	await navigationPromise

	//リダイレクト先URLを取得
	const redirecturl = await page.url();

	//puppeteerを閉じる
	try{
		//ブラウザを閉じる
		await browser.close()
		browser.process().kill('SIGKILL');

		//値を返す
		console.log(redirecturl)
		return redirecturl;
	  }catch(e){
		return "NG";
	  }
}

100

101

102

103

104

105

106

107

//使用するモジュール

const puppeteer = require('puppeteer-core');

var fs = require('fs');

const path = require("path");

var shell = require('child_process').exec;

var spawnSync = require('child_process').spawnSync;

const commandLineArgs = require('command-line-args');

//edge/chromeのパスを取得（ユーザ権限インストール時）

const userHome = process.env[process.platform == "win32" ? "USERPROFILE" : "HOME"];

var kiteipath = "C:\\Program Files (x86)\\Google\\Chrome\\Application\\chrome.exe";

var temppath = path.join(userHome, "AppData\\Local\\Google\\Chrome\\Application\\chrome.exe");

var edgepath = "C:\\Program Files (x86)\\Microsoft\\Edge\\Application\\msedge.exe";

//chrome場所判定

if (fs.existsSync(kiteipath)) {

chromepath = kiteipath

} else {

if (fs.existsSync(temppath)) {

chromepath = temppath;

} else {

//Chromium Edgeの場合に対応

if(fs.existsSync(edgepath)){

chromepath = edgepath;

}else{

//IEを起動してChromeのインストールを促す　　　

shellexec('start "" "iexplore" "https://www.google.co.jp/chrome/"')

return;

}

//コマンドライン引数を取得

//コマンドラインオプションを構築

const optionDefinitions = [

{

alias: 'u',

type: String

{

alias: 's',

type: String

{

alias: 'g',

type: String

}

];

const args = commandLineArgs(optionDefinitions);

//puppeteer実行

main();

//puppeteerメイン関数

async function main() {

const browser = await puppeteer.launch({

headless: false,

executablePath: chromepath,

ignoreDefaultArgs: ["--guest",'--disable-extensions','--start-fullscreen','--incognito',],

slowMo:100,

});

//pageを定義

const page = await browser.newPage()

const navigationPromise = page.waitForNavigation()

//ログインページを開く

await page.goto(args.geturl)

await page.setViewport({ width: 1300, height: 900 })

await navigationPromise

//IDとパスワードを入力

var userid = args.userid;

var pw = args.passwd;

await page.type('#login', userid)

await page.type('#password', pw)

//ログイン実行

await page.waitForSelector('.container > .form > .field_set > .login_submit_div > .btn')

await page.click('.container > .form > .field_set > .login_submit_div > .btn')

await navigationPromise

//認証実行

await page.waitForSelector('#consent_form > #login_content > .login_submit_div > #consent_accept_button > .submit')

await page.click('#consent_form > #login_content > .login_submit_div > #consent_accept_button > .submit')

await navigationPromise

//リダイレクト先URLを取得

const redirecturl = await page.url();

//puppeteerを閉じる

try{

//ブラウザを閉じる

await browser.close()

browser.process().kill('SIGKILL');

//値を返す

console.log(redirecturl)

return redirecturl;

}catch(e){

return "NG";

}

command-line-argsにて、exe実行時の引数を取得しています（オプション指定が必要）
puppeteerでchromeやEdgeを操作しています（puppeteer-coreでもEdgeは操作可能です）
二段階認証の部分はユーザが入力するのですが、navigationPromiseのみでウェイトが掛かってくれます。
認証実行後、page.urlでauthcode付きのリダイレクトURLの値を取得する
最後にconsole.logにて出力すると、これがVBA側への返り値となります。

JSONをParseする

VBA-JSONがあるので、現在では大分、VBAでJSONを扱うのは楽になりました。また、Callbackname関数という面倒な手ではありますが、同じくJSONを解析する為に使える関数もあります。以下のエントリーで後者は扱っています。

Access VBAでNFCを使った社内アプリを作ってみる

しかし、なんだかんだいって、一番扱いやすいのはhtmlfile（Microsoft HTML Object Library）を使った手法です。こちらはWindows11でも使えるのだろうか？と調べてみましたが、何ら問題なく利用可能でした。以下のような形でParseして値を取り出します。

'認証コードを持ってPOST通信でアクセストークンを取得する
Public Function getAccessToken(authcode As String) As Boolean
    '変数を宣言する
    Dim JsonObject As Object, item As Object
    Dim strRes As Variant
    Dim dat As Variant
 
    'JSONをパースする用の変数
    Dim doc, jsn
    Dim access_token As String
    Dim refresh_token As String
    Dim expire_in As Integer
    
    
    'JSON受信用
    'HTMLDocumentを取得
    Set doc = CreateObject("HtmlFile")
    'scriptタグを追加
    doc.Write "<script>document.JsonParse=function (s) {return eval('(' + s + ')');}</script>"
    
    '送信データを組み立て
    dat = "grant_type=" & grant_type & _
        "&code=" & authcode & _
        "&client_id=" & client_id & _
        "&client_secret=" & client_secret
    
    'POST通信でAPIを叩いてデータを取得
    With CreateObject("WinHttp.WinHttpRequest.5.1")
      .Open "POST", tokenurl, False
      '.setProxy 2, proxyuri  'プロキシサーバつかってない場合はコメントアウト
      .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
      .send dat
      
      '返ってきた値をもとにデータを処理
      Select Case .Status
        Case 200
            'JSONデータを取得する
            Json = .responseText
            
            If Len(Trim(Json)) > 0 Then
                'パース関数でJSONオブジェクトを取得
                Set jsn = doc.JsonParse(Json)
                
                'Token情報を取得する
                IniWrite "USER", "access_token", jsn.access_token
                IniWrite "USER", "refresh_token", jsn.refresh_token
                IniWrite "USER", "expire_in", jsn.expires_in

                '値を返す
                getAccessToken = True
            
            Else
                getAccessToken = False
            End If
          
        Case Else
            getAccessToken = False
      End Select
    End With
    
End Function

'認証コードを持ってPOST通信でアクセストークンを取得する

Public Function getAccessToken(authcode As String) As Boolean

'変数を宣言する

Dim JsonObject As Object, item As Object

Dim strRes As Variant

Dim dat As Variant

'JSONをパースする用の変数

Dim doc, jsn

Dim access_token As String

Dim refresh_token As String

Dim expire_in As Integer

'JSON受信用

'HTMLDocumentを取得

Set doc = CreateObject("HtmlFile")

'scriptタグを追加

doc.Write "<script>document.JsonParse=function (s) {return eval('(' + s + ')');}</script>"

'送信データを組み立て

dat = "grant_type=" & grant_type & _

"&code=" & authcode & _

"&client_id=" & client_id & _

"&client_secret=" & client_secret

'POST通信でAPIを叩いてデータを取得

With CreateObject("WinHttp.WinHttpRequest.5.1")

.Open "POST", tokenurl, False

'.setProxy 2, proxyuri 'プロキシサーバつかってない場合はコメントアウト

.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"

.send dat

'返ってきた値をもとにデータを処理

Select Case .Status

Case 200

'JSONデータを取得する

Json = .responseText

If Len(Trim(Json)) > 0 Then

'パース関数でJSONオブジェクトを取得

Set jsn = doc.JsonParse(Json)

'Token情報を取得する

IniWrite "USER", "access_token", jsn.access_token

IniWrite "USER", "refresh_token", jsn.refresh_token

IniWrite "USER", "expire_in", jsn.expires_in

'値を返す

getAccessToken = True

Else

getAccessToken = False

End If

Case Else

getAccessToken = False

End Select

End With

End Function

VBAでOAuth2.0認証 - Windows11対応版

今回利用するモジュールやファイル

新方式が登場しました

Web Driverを使わない手法

事前準備

認証用コード

WebDriverを利用する手法

事前準備

TinySeleniumVBAを使ってみる

事前準備

認証用コード

Selenium Basicを使ってみる

事前準備

認証用コード

SeleniumBasicを管理者権限無しでインストール

WebDriverの自動更新

Puppeteerを使う

概要

単一実行ファイルを作成する

認証用コード

VBA側

Node.js側

JSONをParseする

関連リンク

コメントを残すコメントをキャンセル

Box上のExcelファイルを競合させずに読み書きする

Microsoft365のExcelで使える関数は知らないと損をする

今回利用するモジュールやファイル

新方式が登場しました

Web Driverを使わない手法

事前準備

認証用コード

WebDriverを利用する手法

事前準備

TinySeleniumVBAを使ってみる

事前準備

認証用コード

Selenium Basicを使ってみる

事前準備

認証用コード

SeleniumBasicを管理者権限無しでインストール

WebDriverの自動更新

Puppeteerを使う

概要

単一実行ファイルを作成する

認証用コード

VBA側

Node.js側

JSONをParseする

関連リンク

コメントを残す コメントをキャンセル

Box上のExcelファイルを競合させずに読み書きする

Microsoft365のExcelで使える関数は知らないと損をする

コメントを残すコメントをキャンセル