連載第21回の目的

連載第20回と第21回では、Excel VBAにおけるX APIの活用について紹介します。かつてはTwitter APIと呼ばれた、X社が提供するこのAPIは、同社のSNSの利用のための機能を無償または有償で提供します。このX APIの無料プランを使用して、手元のExcelワークシートに用意してあるデータを、自動でポストするボットのサンプルを作成します（図1）。今回は、ワークシートを作成し、ログインとポストを自動で実行するサンプルを作成していきます。

  • 図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回などを参考にしてください。ワークシートの名前はスクリプトから参照されますので、名前の付け忘れに注意してください。

  • 図2：リストのワークシート（List）が準備された状態

  • 図3：固定データのワークシート（Data）が準備された状態

シート1：リストのワークシート（List）

1個目のシート（リストのワークシート）には、「List」という名前を付けておきます。

・コントロールを配置する
コントロール（コマンドボタン×1）をワークシート上部に配置して、プロパティを設定します。これらのプロパティの内容は、表1のとおりです。

表1：コントロールに設定するプロパティ

コントロール プロパティ 値
「ポスト開始」ボタン Name StartCommandButton
Caption ポスト開始

・ポスト内容を収納するテーブル
ポスト内容を収納するテーブルは、以下の構成とします。テーブルには、セルの内容の取得が容易になるなどのメリットがありますので、今回もテーブルとしておきます。テーブルとするには、以下の見出しを入力したセルを選択し、［ホーム］―［テーブルとして書式設定］を選択します。デザインはお好みのものを選んでください。先頭行を見出し行にする指定も忘れないでください。テーブル名は、「ポストリスト」としておきます。

番号、ポスト日時、ポスト内容、ポスト済み

ポストは、このテーブルの内容に沿って実行されます。「ポスト日時」にはポストの予定日時を、「ポスト内容」にはポストするテキストを記入しておきます。なお、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にドラッグしてください。クラスモジュールに、それらがインポートされます。

  • 図4：「ZeroInstall BrowserDriver for VBA」がインポートされた状態

共有する変数を定義するスクリプト

クライアント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のようになれば完成です。

投稿日時と内容を書き込んで［ポスト開始］ボタンをクリックすると、前回のようにブラウザが起動します。認証してアプリへのアクセス許可を実行すると、ブラウザが閉じて投稿が開始されます。成功した投稿には「○」が表示され、何らかの問題があって失敗した投稿には「×」が表示されます（図5）。

この記事は
Members+会員の方のみ御覧いただけます

ログイン／無料会員登録

会員サービスの詳細はこちら