ゼロからはじめるExcel VBA＋Webサービス 第21回 Xに自動でポストするボットを作成しよう【X API】
2024年9月11日（水）12時21分 マイナビニュース
○連載第21回の目的
連載第20回と第21回では、Excel VBAにおけるX APIの活用について紹介します。かつてはTwitter APIと呼ばれた、X社が提供するこのAPIは、同社のSNSの利用のための機能を無償または有償で提供します。このX APIの無料プランを使用して、手元のExcelワークシートに用意してあるデータを、自動でポストするボットのサンプルを作成します（図1）。今回は、ワークシートを作成し、ログインとポストを自動で実行するサンプルを作成していきます。
▼完成サンプルのExcelファイル
https://github.com/wateryinhare62/mynavi_excelvba_webservice
なお、本連載では動作確認をWindows 10 Pro（64bit）、Microsoft 365（Excel 16.0、VBA 7.1）で行っています。旧バージョンや単体のExcelで試す場合にはご注意ください。
○ワークシートの準備
ここからは、ワークシートを用意し、基本的なデザインを行っていきましょう。今回は、ワークシートを2個使います。配置および書き込むものは、それぞれ以下の通りです（カッコ内はワークシートやコントロールの名前など）。
・シート1：リストシート（List）：ボタンやポスト内容を格納
アプリケーションのタイトル（セルのテキスト）
「ポスト開始」ボタン（StartCommandButton）
ポスト内容を収納するテーブル（ポストリスト）
・シート2：固定データのシート（Data）：X APIにアクセスするための情報
アプリケーションのタイトルなど（セルのテキスト）
クライアントID、クライアントシークレット、リダイレクトURLなどを記載する表（セルのテキスト）
上記のテキストおよびコントロールを、図2〜図3を参考に書き込み、配置してください。具体的な手順は、第6回などを参考にしてください。ワークシートの名前はスクリプトから参照されますので、名前の付け忘れに注意してください。
○シート1：リストのワークシート（List）
1個目のシート（リストのワークシート）には、「List」という名前を付けておきます。
・コントロールを配置する
コントロール（コマンドボタン×1）をワークシート上部に配置して、プロパティを設定します。これらのプロパティの内容は、表1のとおりです。
表1：コントロールに設定するプロパティ
・ポスト内容を収納するテーブル
ポスト内容を収納するテーブルは、以下の構成とします。テーブルには、セルの内容の取得が容易になるなどのメリットがありますので、今回もテーブルとしておきます。テーブルとするには、以下の見出しを入力したセルを選択し、［ホーム］—［テーブルとして書式設定］を選択します。デザインはお好みのものを選んでください。先頭行を見出し行にする指定も忘れないでください。テーブル名は、「ポストリスト」としておきます。
番号、ポスト日時、ポスト内容、ポスト済み
ポストは、このテーブルの内容に沿って実行されます。「ポスト日時」にはポストの予定日時を、「ポスト内容」にはポストするテキストを記入しておきます。なお、API v2の制限のため、ポスト日時は1時間に1〜2回ほどにしておくのが良いでしょう。
○シート2：固定データのワークシート（Data）
固定データのワークシートには、「Data」という名前を付けておきます。
・固定データを記載した表
表は、以下の構成とします。普通にセルのテキストとして配置します。データの位置はスクリプトで決め打ちしているので、配置を変更する場合には注意してください。
・「No」（番号、プログラム上は意味はありません）
・「項目」（項目名、プログラム上は意味はありません）
・「内容」（項目のデータ。これらをスクリプトから取得、設定します）
「内容」のNo.1〜No.3には、前回に取得したクライアントIDとクライアントシークレット、リダイレクトURLとして前回に設定した「https://x.com/」を記入しておいてください。No.4〜No.8は、アプリが取得したアクセストークンなどを保持する場所なので、空欄のままでかまいません。
ここで、ブックを保存します。ブック名は何でもよいですが、形式を「Excel マクロ有効ブック (*.xlsm)」にしてください。マクロを有効にしておかないと、VBAのスクリプトを実行できないからです。このあとも、適当なタイミングでブックを保存してください。
○スクリプトを書いていく
ここから、Visual Basic Editorを使って、以下の順番でスクリプトを書いていきます。左ペインの「Microsoft Excel Objects」の「Sheet1 (List)」をダブルクリックして開くファイルに、以下のスクリプトを記述していきます。
・共有する変数を定義するスクリプト
・ボタンクリックでポストを開始するスクリプト（イベントハンドラ）
・ポストを実行するスクリプト（関数）
・アクセストークンを取得するスクリプト（関数）
・認可コードを取得するスクリプト（関数）
・その他のスクリプト（非掲載）
［NOTE］必要なライブラリと参照設定
サンプルでは、いくつかのライブラリを使います。これまでの回で紹介したものも含めて、以下のライブラリを用意して、必要な参照設定を有効にしてください。
・ライブラリ「VBA-JSON」（第3回）
・参照設定「Microsoft Scripting Runtime」（第3回）
・参照設定「Microsoft ActiveX Data Objects 6.1 Library」（第7回）
・参照設定「Microsoft WinHTTP Services, version 5.1」（今回）
○ZeroInstall BrowserDriver for VBA
今回のサンプルはX APIのOAuth認証を使うので、VBAからブラウザを起動する必要があります。このような場合にはSeleniumといったスクレイピング用のアプリを使うのが定番でしたが、開発が終了している、事前準備が複雑などの理由で、今回は「ZeroInstall BrowserDriver for VBA」というMITライセンスのライブラリを使うことにします。このライブラリをプロジェクトにインポートするだけで、簡単なスクリプトでブラウザをコントロールできます。
以下のGitHubリポジトリから、［Code］をクリックし、さらに［Download ZIP］をクリックしてZipファイルをダウンロードしてください。
▼24000/ChromeControler-No-Selenium-WebDriver-VBAJSON: 【VBA】セレニウム、WebDriver、VBAJSONを使わずにChromeとEdgeを操作する
https://github.com/24000/ChromeControler-No-Selenium-WebDriver-VBAJSON/tree/master
Zipファイルを解凍して、srcフォルダ内にある拡張子が.clsであるファイルを、全てVBAProjectにドラッグしてください。クラスモジュールに、それらがインポートされます。
○共有する変数を定義するスクリプト
クライアントIDやクライアントシークレット、リダイレクト先URLといった、利用者ごとに異なる情報は専用のワークシートに記載しておくことにしました（本来であれば、ワークシート外から取得する方が安全ですが、簡略化しています）。ここでは、それぞれの変数を定義し、そこに格納しておきます。これらの変数は、Dataワークシートから取得して値が設定されます。また、スクリプトで共通に使用するDataワークシートのオブジェクトと、APIアクセス用のWinHttpRequestオブジェクトも、ここに変数として定義しておきます。なお、変数の定義とは直接の関係はないですが、安全のために冒頭でOption Explicit文によって未定義の変数を使えないようにしています（リスト1）。
［リスト1］共有する変数を定義
' 未定義の変数を使えないようにする
Option Explicit
' クライアントIDを保持
Dim ClientId As String
' クライアントシークレットを保持
Dim ClientSecret As String
' リダイレクトURLを保持
Dim RedirectUrl As String
' Dataワークシートオブジェクトを保持
Dim DataWorksheet As Worksheet
' HTTPアクセスオブジェクトを保持
Dim HttpRequest As WinHttpRequest
○ボタンクリックでポストを開始するスクリプト（イベントハンドラ）
次に、ボタンクリックでポストを開始するスクリプトを書いていきましょう。このスクリプトは、［ポスト開始］ボタンをクリックした際に呼び出されるイベントハンドラStartCommandButton_Clickとして記述します（リスト2以降）。以下の流れで、テーブルからデータを取得して条件に合う投稿をポストしています。
①固定データと必要なオブジェクトを取得、生成する
②全てのポストを実行する
以下は、リストの解説になります。上記の流れに合わせて適宜区切っています。
［リスト2］ボタンクリックでポストを開始するスクリプト（その1）
' (1)共有オブジェクトを取得、生成する
Set DataWorksheet = Worksheets("Data")
Set HttpRequest = New WinHttpRequest
' (2)各種固定データを取得する
ClientId = DataWorksheet.Range("C4").value
ClientSecret = DataWorksheet.Range("C5").value
RedirectUrl = DataWorksheet.Range("C6").value
' (3)テーブルを取得しておく
Dim Table As Variant
Set Table = ActiveSheet.ListObjects("ポストリスト")
①に相当するスクリプトです。（1）からは、Dataワークシートオブジェクトの取得とWinHttpRequestオブジェクトの生成を実行しています。（2）からは、クライアントID、クライアントシークレット、リダイレクトURLをDataワークシートから取得しています。セル位置は決め打ちとしているので、必要に応じて修正してください。結果は、それぞれの変数に格納します。（3）は、テーブル「ポストリスト」オブジェクトの取得です。
［リスト3］ボタンクリックでポストを開始するスクリプト（その2）
' (4)未ポストデータが存在する限り繰り返す
Dim ExistFlag As Boolean
ExistFlag = True
While ExistFlag
ExistFlag = False
' (5)全ての行について処理する
Dim RowIndex As Integer, ColIndex As Integer
For RowIndex = 1 To Table.DataBodyRange.Rows.count
' (6)有効なデータがあるときのみ
If Table.DataBodyRange.Cells(RowIndex, 1) "" Then
' (7)ポスト済みでないときのみ
If Table.DataBodyRange.Cells(RowIndex, 4) "○" Then
' (8)指定日時を超過したときのみ
Dim NowTime As Variant, PostTime As Variant
NowTime = Now()
PostTime = Table.DataBodyRange.Cells(RowIndex, 2)
If DateDiff("s", PostTime, NowTime) >= 0 Then
Range("D3").value = "ポスト中..."
' (9)ポストをポストする
If ExecutePost(Table.DataBodyRange.Cells(RowIndex, 3)) Then
Table.DataBodyRange.Cells(RowIndex, 4) = "○"
Else
Table.DataBodyRange.Cells(RowIndex, 4) = "×"
ExistFlag = True
End If
Else
ExistFlag = True
End If
End If
End If
Next
DoEvents
' (10)未ポストデータがあれば10分待機する
If ExistFlag Then
Range("D3").value = "待機中(Escキーで中止)..."
DoEvents
If Not Application.wait(Now() + TimeValue("00:10:00")) Then
ExistFlag = False
End If
End If
Wend
②に相当するスクリプトです。
（4）からは、未ポストデータがある限り繰り返すループを開始しています。未ポストデータがあるかの判断は、（5）からのループでポストされなかったデータが残っているかどうかです。
（5）からで、テーブルの全データに対するループを開始していますが、（6）データあり、（7）ポスト済みでない、（8）指定日時超過している、というようにフィルタをかけています。このうち（8）では、現在日時（Now()）とセルの日時をDateDiff関数で比較し、プラスすなわち超過であれば（9）のポスト処理を実行するという判定になっています。
（9）のポスト処理は、後述するExecutePost関数の呼び出しですが、その成否でテーブルに「○」か「×」を書き込みます。前者はポスト済みを表し、後者はポスト失敗を表します。これらは、（7）における判定で使用されます。
最後の（10）は、未ポストデータありの場合の次回のポストまでの待機です。本サンプルでは、負荷が高くならないように10分ごとにポストを実行しています。ここに用いるのがApplication.waitメソッドです。このメソッドは、指定した時刻になるまでスクリプトの実行を待機し、Escキーが入力されると中断します。中断されるとFalse、待機終了するとTrueを返すので、全体のループの中断に戻り値を利用しています。
○ポストを実行するスクリプト
次に、ポストを実行するスクリプトを書いていきましょう。このスクリプトは、リスト3から呼び出されるExecutePost関数となります。この関数は、ポスト内容をString型で受け取り、ポストの成否をBoolean型で返します。
［リスト4］ワークシートを生成してセルに書き込むスクリプト（その1）
Private Function ExecutePost(ByVal PostString As String) As Boolean
' (1)アクセストークンを取得する
Dim AccessToken As String
AccessToken = GetAccessToken()
If AccessToken = "" Then
ExecutePost = False
Else
' (2)アクセストークンが取得できたらポストを実行する
With HttpRequest
.Open "POST", "https://api.twitter.com/2/tweets", False
.SetRequestHeader "Authorization", "Bearer " & AccessToken
.SetRequestHeader "Content-Type", "application/json;charset=UTF-8"
.Send EncodeUTF8("{""text"": """ & PostString & """}")
' (3)ポスト成功（HTTP 201）であるかで戻り値を決める
If .Status = 201 Then
ExecutePost = True
Else
ExecutePost = False
End If
End With
End If
End Function
（1）からは、ポストに必要なアクセストークンを後述するGetAccessToken関数によって取得しています。戻り値が空であれば取得に失敗しているので、その場合は関数自体の戻り値もFalse（失敗）として終了しています。
（2）からは、ポストの実行であるHTTP POSTリクエストの送信処理です。この流れは今までと同様で、HTTP POSTメソッドの指定、エンドポイントURLの指定、リクエストヘッダの指定（SetRequestHeader）、リクエストボディの送信（Send）です。リクエストヘッダは2つあり、一つはアクセストークンを埋め込むAuthorizationヘッダ、もう一つはデータタイプがJSONであることを示すContent-Typeヘッダです。ポストデータ（JSON形式）は、ポストテキストを指定する"text"キーのみ指定し、EncodeUTF8プロシージャによってUTF-8エンコーディングしています。EncodeUTF8関数の内容については、サンプルファイルを参照してください。
（4）では、レスポンスのステータスが201であるか判断し、それによって関数の戻り値を決定しています。なお、ステータス201とは、ポストに成功し、ポストデータがレスポンスされたことを示しています。
○アクセストークンを取得するスクリプト
続けて、アクセストークンを取得するスクリプトを書いていきましょう。このスクリプトは、リスト4から呼び出されるGetAccessToken関数となります。この関数は、アクセストークンを文字列で返しますが、何らかの理由で取得に失敗した場合には空文字列を返します。
［リスト5］アクセストークンを取得するスクリプト（GetAccessToken関数）
…変数宣言は略…
' (1)アクセストークンが取得済みかどうかで処理を分ける
AccessToken = DataWorksheet.Range("C7").value
If AccessToken = "" Then
' (2)認可コードを取得する
Dim AuthCode As String
AuthCode = GetAuthCode
If AuthCode = "" Then
Exit Function
End If
' (3)認可コードからアクセストークンを取得する
PostData = "code=" & AuthCode & "&" & _
"grant_type=authorization_code&" & _
"redirect_uri=" & RedirectUrl & "&" & _
"code_verifier=challenge&" & _
"client_id=" & ClientId
' (4)クライアントIDとクライアントシークレットをBase64エンコーディングする
Set Node = CreateObject("MSXML2.DOMDocument.3.0").createElement("base64")
Node.DataType = "bin.base64"
Node.nodeTypedValue = ConvertToBinary(ClientId & ":" & ClientSecret)
' (5)HTTP POSTリクエストを実行する
With HttpRequest
.Open "POST", "https://api.twitter.com/2/oauth2/token", False
.SetRequestHeader "Content-Type", _
"application/x-www-form-urlencoded;charset=UTF-8"
.SetRequestHeader "Authorization", "Basic " & Replace(Node.Text, vbLf, "")
.Send PostData
' (6)取得に成功したらJSONから値を取り出す
If .Status = 200 Then
JsonStr = .responseText
If Len(Trim(JsonStr)) >0 Then
Set Json = JsonConverter.ParseJson(JsonStr)
AccessToken = Json("access_token")
RefreshToken = Json("refresh_token")
ExpiresIn = Json("expires_in")
TimeNow = Now()
TimeExpires = DateAdd("s", Val(ExpiresIn), TimeNow)
DataWorksheet.Range("C7").value = AccessToken
DataWorksheet.Range("C8").value = RefreshToken
DataWorksheet.Range("C9").value = ExpiresIn
DataWorksheet.Range("C10").value = TimeNow
DataWorksheet.Range("C11").value = TimeExpires
GetAccessToken = AccessToken
End If
End If
End With
Else
' アクセストークン取得済みの場合
…略…
End If
（1）では、アクセストークンが取得済み（Dataワークシートに記入済み）であるかで処理を分けています。未取得であれば、OAuth認証の手続きに基づき認可コードの取得、認可コードを用いたアクセストークンの取得を行います。取得済みであれば有効期間内であるかを判定し、そうであれば取得済みのアクセストークンをそのまま返し、そうでない場合にはリフレッシュトークンを用いたアクセストークンの再取得を行います。
まずは、未取得の処理です。（2）で、後述するGetAuthCode関数を呼び出し、認可コードを取得します。空であれば、戻り値を空文字列にしたまま関数から抜けます。
（3）からは、アクセストークン取得のためのリクエストボディを構築しています。（4）からはBasic認証のためにクライアントIDとクライアントシークレットをBase64エンコーディングしています。そして（5）でリクエストを送信しています。リクエストヘッダに、Authorizationヘッダで先ほどのBasic認証のトークンを指定しています。
エラーなく取得できたら、（6）以降でレスポンスボディのJSONデータから各値を取り出し、Dataワークシートに格納しています。最後に、アクセストークンを関数の戻り値として終了です。
アクセストークンの再取得については、リクエストボディの構成が変わる以外は基本的な流れは同じですので、配布サンプルを参照してください。
○認可コードを取得するスクリプト
最後は、認可コードを取得するスクリプトです。このスクリプトは、リスト5から呼び出されるGetAuthCode関数となります。この関数は、認可コードを文字列で返しますが、何らかの理由で取得に失敗した場合には空文字列を返します。
［リスト6］認可コードを取得するスクリプト（GetAuthCode関数）
' (1)OAuth認可コード取得URLを生成する
Dim OAuthUrl As String
OAuthUrl = "https://twitter.com/i/oauth2/authorize?" & _
"response_type=code&" & _
"client_id=" & ClientId & "&" & _
"redirect_uri=" & RedirectUrl & "&" & _
"scope=" & WorksheetFunction.EncodeURL("tweet.read tweet.write users.read offline.access") & "&" & _
"state=state&" & _
"code_challenge=challenge&" & _
"code_challenge_method=plain"
' (2)ブラウザを起動しユーザによる認証、許可を実行する
Dim Driver As IWebDriver
Set Driver = New EdgeDriver
Driver.OpenURL (OAuthUrl)
Driver.SleepByWinAPI 3600
' (3)ブラウザのURLがリダイレクトURL（code=を含む）になるまで待機する
Dim AuthCode As String
Dim TempUrl As String
AuthCode = ""
Do While AuthCode = ""
TempUrl = Driver.URL
If InStr(LCase(TempUrl), "code=") < 1 Then
DoEvents
Else
AuthCode = TempUrl
End If
Loop
' (4)認可コードを取得してブラウザを閉じる
AuthCode = GetParam(AuthCode, "code")
Driver.SleepByWinAPI 1000
Driver.CloseWindow
GetAuthCode = AuthCode
認可コード取得URLを作成し、ZeroInstall BrowserDriverによってブラウザを起動、X側での認証、許諾処理のあと、リダイレクトされてくるURLから認可コードを切り出す、そんな流れになっています。
（1）からは、URLの構築です。パラメータは、すべてURLに埋め込みます。
（2）からは、ブラウザの起動です。ここではMicrosoft Edge用のEdgeDriverオブジェクトを生成しています。openメソッドで引数のURLを開き、SleepByWinAPIメソッドで3600ミリ秒（3.6秒）ブラウザ起動と操作を待機します。
この先は、ブラウザ側で認証、許諾の操作が行われていますが、それが終了してリダイレクトURLに遷移するのを待機するのが（3）からです。URLメソッドで取得したURLに「code=」が含まれれば遷移終了と判断します。
（4）からは、URLからGetParam関数で認可コードを取得し、ブラウザをクローズします。GetParam関数のコードについては配布サンプルを参照してください。
これで、スクリプトの作成は終了です。ワークシートの形を整えて冒頭の図1のようになれば完成です。
.
連載第20回と第21回では、Excel VBAにおけるX APIの活用について紹介します。かつてはTwitter APIと呼ばれた、X社が提供するこのAPIは、同社のSNSの利用のための機能を無償または有償で提供します。このX APIの無料プランを使用して、手元のExcelワークシートに用意してあるデータを、自動でポストするボットのサンプルを作成します（図1）。今回は、ワークシートを作成し、ログインとポストを自動で実行するサンプルを作成していきます。
▼完成サンプルのExcelファイル
https://github.com/wateryinhare62/mynavi_excelvba_webservice
なお、本連載では動作確認をWindows 10 Pro（64bit）、Microsoft 365（Excel 16.0、VBA 7.1）で行っています。旧バージョンや単体のExcelで試す場合にはご注意ください。
○ワークシートの準備
ここからは、ワークシートを用意し、基本的なデザインを行っていきましょう。今回は、ワークシートを2個使います。配置および書き込むものは、それぞれ以下の通りです（カッコ内はワークシートやコントロールの名前など）。
・シート1：リストシート（List）：ボタンやポスト内容を格納
アプリケーションのタイトル（セルのテキスト）
「ポスト開始」ボタン（StartCommandButton）
ポスト内容を収納するテーブル（ポストリスト）
・シート2：固定データのシート（Data）：X APIにアクセスするための情報
アプリケーションのタイトルなど（セルのテキスト）
クライアントID、クライアントシークレット、リダイレクトURLなどを記載する表（セルのテキスト）
上記のテキストおよびコントロールを、図2〜図3を参考に書き込み、配置してください。具体的な手順は、第6回などを参考にしてください。ワークシートの名前はスクリプトから参照されますので、名前の付け忘れに注意してください。
○シート1：リストのワークシート（List）
1個目のシート（リストのワークシート）には、「List」という名前を付けておきます。
・コントロールを配置する
コントロール（コマンドボタン×1）をワークシート上部に配置して、プロパティを設定します。これらのプロパティの内容は、表1のとおりです。
表1：コントロールに設定するプロパティ
・ポスト内容を収納するテーブル
ポスト内容を収納するテーブルは、以下の構成とします。テーブルには、セルの内容の取得が容易になるなどのメリットがありますので、今回もテーブルとしておきます。テーブルとするには、以下の見出しを入力したセルを選択し、［ホーム］—［テーブルとして書式設定］を選択します。デザインはお好みのものを選んでください。先頭行を見出し行にする指定も忘れないでください。テーブル名は、「ポストリスト」としておきます。
番号、ポスト日時、ポスト内容、ポスト済み
ポストは、このテーブルの内容に沿って実行されます。「ポスト日時」にはポストの予定日時を、「ポスト内容」にはポストするテキストを記入しておきます。なお、API v2の制限のため、ポスト日時は1時間に1〜2回ほどにしておくのが良いでしょう。
○シート2：固定データのワークシート（Data）
固定データのワークシートには、「Data」という名前を付けておきます。
・固定データを記載した表
表は、以下の構成とします。普通にセルのテキストとして配置します。データの位置はスクリプトで決め打ちしているので、配置を変更する場合には注意してください。
・「No」（番号、プログラム上は意味はありません）
・「項目」（項目名、プログラム上は意味はありません）
・「内容」（項目のデータ。これらをスクリプトから取得、設定します）
「内容」のNo.1〜No.3には、前回に取得したクライアントIDとクライアントシークレット、リダイレクトURLとして前回に設定した「https://x.com/」を記入しておいてください。No.4〜No.8は、アプリが取得したアクセストークンなどを保持する場所なので、空欄のままでかまいません。
ここで、ブックを保存します。ブック名は何でもよいですが、形式を「Excel マクロ有効ブック (*.xlsm)」にしてください。マクロを有効にしておかないと、VBAのスクリプトを実行できないからです。このあとも、適当なタイミングでブックを保存してください。
○スクリプトを書いていく
ここから、Visual Basic Editorを使って、以下の順番でスクリプトを書いていきます。左ペインの「Microsoft Excel Objects」の「Sheet1 (List)」をダブルクリックして開くファイルに、以下のスクリプトを記述していきます。
・共有する変数を定義するスクリプト
・ボタンクリックでポストを開始するスクリプト（イベントハンドラ）
・ポストを実行するスクリプト（関数）
・アクセストークンを取得するスクリプト（関数）
・認可コードを取得するスクリプト（関数）
・その他のスクリプト（非掲載）
［NOTE］必要なライブラリと参照設定
サンプルでは、いくつかのライブラリを使います。これまでの回で紹介したものも含めて、以下のライブラリを用意して、必要な参照設定を有効にしてください。
・ライブラリ「VBA-JSON」（第3回）
・参照設定「Microsoft Scripting Runtime」（第3回）
・参照設定「Microsoft ActiveX Data Objects 6.1 Library」（第7回）
・参照設定「Microsoft WinHTTP Services, version 5.1」（今回）
○ZeroInstall BrowserDriver for VBA
今回のサンプルはX APIのOAuth認証を使うので、VBAからブラウザを起動する必要があります。このような場合にはSeleniumといったスクレイピング用のアプリを使うのが定番でしたが、開発が終了している、事前準備が複雑などの理由で、今回は「ZeroInstall BrowserDriver for VBA」というMITライセンスのライブラリを使うことにします。このライブラリをプロジェクトにインポートするだけで、簡単なスクリプトでブラウザをコントロールできます。
以下のGitHubリポジトリから、［Code］をクリックし、さらに［Download ZIP］をクリックしてZipファイルをダウンロードしてください。
▼24000/ChromeControler-No-Selenium-WebDriver-VBAJSON: 【VBA】セレニウム、WebDriver、VBAJSONを使わずにChromeとEdgeを操作する
https://github.com/24000/ChromeControler-No-Selenium-WebDriver-VBAJSON/tree/master
Zipファイルを解凍して、srcフォルダ内にある拡張子が.clsであるファイルを、全てVBAProjectにドラッグしてください。クラスモジュールに、それらがインポートされます。
○共有する変数を定義するスクリプト
クライアントIDやクライアントシークレット、リダイレクト先URLといった、利用者ごとに異なる情報は専用のワークシートに記載しておくことにしました（本来であれば、ワークシート外から取得する方が安全ですが、簡略化しています）。ここでは、それぞれの変数を定義し、そこに格納しておきます。これらの変数は、Dataワークシートから取得して値が設定されます。また、スクリプトで共通に使用するDataワークシートのオブジェクトと、APIアクセス用のWinHttpRequestオブジェクトも、ここに変数として定義しておきます。なお、変数の定義とは直接の関係はないですが、安全のために冒頭でOption Explicit文によって未定義の変数を使えないようにしています（リスト1）。
［リスト1］共有する変数を定義
' 未定義の変数を使えないようにする
Option Explicit
' クライアントIDを保持
Dim ClientId As String
' クライアントシークレットを保持
Dim ClientSecret As String
' リダイレクトURLを保持
Dim RedirectUrl As String
' Dataワークシートオブジェクトを保持
Dim DataWorksheet As Worksheet
' HTTPアクセスオブジェクトを保持
Dim HttpRequest As WinHttpRequest
○ボタンクリックでポストを開始するスクリプト（イベントハンドラ）
次に、ボタンクリックでポストを開始するスクリプトを書いていきましょう。このスクリプトは、［ポスト開始］ボタンをクリックした際に呼び出されるイベントハンドラStartCommandButton_Clickとして記述します（リスト2以降）。以下の流れで、テーブルからデータを取得して条件に合う投稿をポストしています。
①固定データと必要なオブジェクトを取得、生成する
②全てのポストを実行する
以下は、リストの解説になります。上記の流れに合わせて適宜区切っています。
［リスト2］ボタンクリックでポストを開始するスクリプト（その1）
' (1)共有オブジェクトを取得、生成する
Set DataWorksheet = Worksheets("Data")
Set HttpRequest = New WinHttpRequest
' (2)各種固定データを取得する
ClientId = DataWorksheet.Range("C4").value
ClientSecret = DataWorksheet.Range("C5").value
RedirectUrl = DataWorksheet.Range("C6").value
' (3)テーブルを取得しておく
Dim Table As Variant
Set Table = ActiveSheet.ListObjects("ポストリスト")
①に相当するスクリプトです。（1）からは、Dataワークシートオブジェクトの取得とWinHttpRequestオブジェクトの生成を実行しています。（2）からは、クライアントID、クライアントシークレット、リダイレクトURLをDataワークシートから取得しています。セル位置は決め打ちとしているので、必要に応じて修正してください。結果は、それぞれの変数に格納します。（3）は、テーブル「ポストリスト」オブジェクトの取得です。
［リスト3］ボタンクリックでポストを開始するスクリプト（その2）
' (4)未ポストデータが存在する限り繰り返す
Dim ExistFlag As Boolean
ExistFlag = True
While ExistFlag
ExistFlag = False
' (5)全ての行について処理する
Dim RowIndex As Integer, ColIndex As Integer
For RowIndex = 1 To Table.DataBodyRange.Rows.count
' (6)有効なデータがあるときのみ
If Table.DataBodyRange.Cells(RowIndex, 1) "" Then
' (7)ポスト済みでないときのみ
If Table.DataBodyRange.Cells(RowIndex, 4) "○" Then
' (8)指定日時を超過したときのみ
Dim NowTime As Variant, PostTime As Variant
NowTime = Now()
PostTime = Table.DataBodyRange.Cells(RowIndex, 2)
If DateDiff("s", PostTime, NowTime) >= 0 Then
Range("D3").value = "ポスト中..."
' (9)ポストをポストする
If ExecutePost(Table.DataBodyRange.Cells(RowIndex, 3)) Then
Table.DataBodyRange.Cells(RowIndex, 4) = "○"
Else
Table.DataBodyRange.Cells(RowIndex, 4) = "×"
ExistFlag = True
End If
Else
ExistFlag = True
End If
End If
End If
Next
DoEvents
' (10)未ポストデータがあれば10分待機する
If ExistFlag Then
Range("D3").value = "待機中(Escキーで中止)..."
DoEvents
If Not Application.wait(Now() + TimeValue("00:10:00")) Then
ExistFlag = False
End If
End If
Wend
②に相当するスクリプトです。
（4）からは、未ポストデータがある限り繰り返すループを開始しています。未ポストデータがあるかの判断は、（5）からのループでポストされなかったデータが残っているかどうかです。
（5）からで、テーブルの全データに対するループを開始していますが、（6）データあり、（7）ポスト済みでない、（8）指定日時超過している、というようにフィルタをかけています。このうち（8）では、現在日時（Now()）とセルの日時をDateDiff関数で比較し、プラスすなわち超過であれば（9）のポスト処理を実行するという判定になっています。
（9）のポスト処理は、後述するExecutePost関数の呼び出しですが、その成否でテーブルに「○」か「×」を書き込みます。前者はポスト済みを表し、後者はポスト失敗を表します。これらは、（7）における判定で使用されます。
最後の（10）は、未ポストデータありの場合の次回のポストまでの待機です。本サンプルでは、負荷が高くならないように10分ごとにポストを実行しています。ここに用いるのがApplication.waitメソッドです。このメソッドは、指定した時刻になるまでスクリプトの実行を待機し、Escキーが入力されると中断します。中断されるとFalse、待機終了するとTrueを返すので、全体のループの中断に戻り値を利用しています。
○ポストを実行するスクリプト
次に、ポストを実行するスクリプトを書いていきましょう。このスクリプトは、リスト3から呼び出されるExecutePost関数となります。この関数は、ポスト内容をString型で受け取り、ポストの成否をBoolean型で返します。
［リスト4］ワークシートを生成してセルに書き込むスクリプト（その1）
Private Function ExecutePost(ByVal PostString As String) As Boolean
' (1)アクセストークンを取得する
Dim AccessToken As String
AccessToken = GetAccessToken()
If AccessToken = "" Then
ExecutePost = False
Else
' (2)アクセストークンが取得できたらポストを実行する
With HttpRequest
.Open "POST", "https://api.twitter.com/2/tweets", False
.SetRequestHeader "Authorization", "Bearer " & AccessToken
.SetRequestHeader "Content-Type", "application/json;charset=UTF-8"
.Send EncodeUTF8("{""text"": """ & PostString & """}")
' (3)ポスト成功（HTTP 201）であるかで戻り値を決める
If .Status = 201 Then
ExecutePost = True
Else
ExecutePost = False
End If
End With
End If
End Function
（1）からは、ポストに必要なアクセストークンを後述するGetAccessToken関数によって取得しています。戻り値が空であれば取得に失敗しているので、その場合は関数自体の戻り値もFalse（失敗）として終了しています。
（2）からは、ポストの実行であるHTTP POSTリクエストの送信処理です。この流れは今までと同様で、HTTP POSTメソッドの指定、エンドポイントURLの指定、リクエストヘッダの指定（SetRequestHeader）、リクエストボディの送信（Send）です。リクエストヘッダは2つあり、一つはアクセストークンを埋め込むAuthorizationヘッダ、もう一つはデータタイプがJSONであることを示すContent-Typeヘッダです。ポストデータ（JSON形式）は、ポストテキストを指定する"text"キーのみ指定し、EncodeUTF8プロシージャによってUTF-8エンコーディングしています。EncodeUTF8関数の内容については、サンプルファイルを参照してください。
（4）では、レスポンスのステータスが201であるか判断し、それによって関数の戻り値を決定しています。なお、ステータス201とは、ポストに成功し、ポストデータがレスポンスされたことを示しています。
○アクセストークンを取得するスクリプト
続けて、アクセストークンを取得するスクリプトを書いていきましょう。このスクリプトは、リスト4から呼び出されるGetAccessToken関数となります。この関数は、アクセストークンを文字列で返しますが、何らかの理由で取得に失敗した場合には空文字列を返します。
［リスト5］アクセストークンを取得するスクリプト（GetAccessToken関数）
…変数宣言は略…
' (1)アクセストークンが取得済みかどうかで処理を分ける
AccessToken = DataWorksheet.Range("C7").value
If AccessToken = "" Then
' (2)認可コードを取得する
Dim AuthCode As String
AuthCode = GetAuthCode
If AuthCode = "" Then
Exit Function
End If
' (3)認可コードからアクセストークンを取得する
PostData = "code=" & AuthCode & "&" & _
"grant_type=authorization_code&" & _
"redirect_uri=" & RedirectUrl & "&" & _
"code_verifier=challenge&" & _
"client_id=" & ClientId
' (4)クライアントIDとクライアントシークレットをBase64エンコーディングする
Set Node = CreateObject("MSXML2.DOMDocument.3.0").createElement("base64")
Node.DataType = "bin.base64"
Node.nodeTypedValue = ConvertToBinary(ClientId & ":" & ClientSecret)
' (5)HTTP POSTリクエストを実行する
With HttpRequest
.Open "POST", "https://api.twitter.com/2/oauth2/token", False
.SetRequestHeader "Content-Type", _
"application/x-www-form-urlencoded;charset=UTF-8"
.SetRequestHeader "Authorization", "Basic " & Replace(Node.Text, vbLf, "")
.Send PostData
' (6)取得に成功したらJSONから値を取り出す
If .Status = 200 Then
JsonStr = .responseText
If Len(Trim(JsonStr)) >0 Then
Set Json = JsonConverter.ParseJson(JsonStr)
AccessToken = Json("access_token")
RefreshToken = Json("refresh_token")
ExpiresIn = Json("expires_in")
TimeNow = Now()
TimeExpires = DateAdd("s", Val(ExpiresIn), TimeNow)
DataWorksheet.Range("C7").value = AccessToken
DataWorksheet.Range("C8").value = RefreshToken
DataWorksheet.Range("C9").value = ExpiresIn
DataWorksheet.Range("C10").value = TimeNow
DataWorksheet.Range("C11").value = TimeExpires
GetAccessToken = AccessToken
End If
End If
End With
Else
' アクセストークン取得済みの場合
…略…
End If
（1）では、アクセストークンが取得済み（Dataワークシートに記入済み）であるかで処理を分けています。未取得であれば、OAuth認証の手続きに基づき認可コードの取得、認可コードを用いたアクセストークンの取得を行います。取得済みであれば有効期間内であるかを判定し、そうであれば取得済みのアクセストークンをそのまま返し、そうでない場合にはリフレッシュトークンを用いたアクセストークンの再取得を行います。
まずは、未取得の処理です。（2）で、後述するGetAuthCode関数を呼び出し、認可コードを取得します。空であれば、戻り値を空文字列にしたまま関数から抜けます。
（3）からは、アクセストークン取得のためのリクエストボディを構築しています。（4）からはBasic認証のためにクライアントIDとクライアントシークレットをBase64エンコーディングしています。そして（5）でリクエストを送信しています。リクエストヘッダに、Authorizationヘッダで先ほどのBasic認証のトークンを指定しています。
エラーなく取得できたら、（6）以降でレスポンスボディのJSONデータから各値を取り出し、Dataワークシートに格納しています。最後に、アクセストークンを関数の戻り値として終了です。
アクセストークンの再取得については、リクエストボディの構成が変わる以外は基本的な流れは同じですので、配布サンプルを参照してください。
○認可コードを取得するスクリプト
最後は、認可コードを取得するスクリプトです。このスクリプトは、リスト5から呼び出されるGetAuthCode関数となります。この関数は、認可コードを文字列で返しますが、何らかの理由で取得に失敗した場合には空文字列を返します。
［リスト6］認可コードを取得するスクリプト（GetAuthCode関数）
' (1)OAuth認可コード取得URLを生成する
Dim OAuthUrl As String
OAuthUrl = "https://twitter.com/i/oauth2/authorize?" & _
"response_type=code&" & _
"client_id=" & ClientId & "&" & _
"redirect_uri=" & RedirectUrl & "&" & _
"scope=" & WorksheetFunction.EncodeURL("tweet.read tweet.write users.read offline.access") & "&" & _
"state=state&" & _
"code_challenge=challenge&" & _
"code_challenge_method=plain"
' (2)ブラウザを起動しユーザによる認証、許可を実行する
Dim Driver As IWebDriver
Set Driver = New EdgeDriver
Driver.OpenURL (OAuthUrl)
Driver.SleepByWinAPI 3600
' (3)ブラウザのURLがリダイレクトURL（code=を含む）になるまで待機する
Dim AuthCode As String
Dim TempUrl As String
AuthCode = ""
Do While AuthCode = ""
TempUrl = Driver.URL
If InStr(LCase(TempUrl), "code=") < 1 Then
DoEvents
Else
AuthCode = TempUrl
End If
Loop
' (4)認可コードを取得してブラウザを閉じる
AuthCode = GetParam(AuthCode, "code")
Driver.SleepByWinAPI 1000
Driver.CloseWindow
GetAuthCode = AuthCode
認可コード取得URLを作成し、ZeroInstall BrowserDriverによってブラウザを起動、X側での認証、許諾処理のあと、リダイレクトされてくるURLから認可コードを切り出す、そんな流れになっています。
（1）からは、URLの構築です。パラメータは、すべてURLに埋め込みます。
（2）からは、ブラウザの起動です。ここではMicrosoft Edge用のEdgeDriverオブジェクトを生成しています。openメソッドで引数のURLを開き、SleepByWinAPIメソッドで3600ミリ秒（3.6秒）ブラウザ起動と操作を待機します。
この先は、ブラウザ側で認証、許諾の操作が行われていますが、それが終了してリダイレクトURLに遷移するのを待機するのが（3）からです。URLメソッドで取得したURLに「code=」が含まれれば遷移終了と判断します。
（4）からは、URLからGetParam関数で認可コードを取得し、ブラウザをクローズします。GetParam関数のコードについては配布サンプルを参照してください。
これで、スクリプトの作成は終了です。ワークシートの形を整えて冒頭の図1のようになれば完成です。
.
