Excel VBAでSeleniumBasicを使わずにスクレイピングする

こんにちは。ExcelVBAからIEを制御する本の著者であり、妹にExcelVBAからIEを制御する方法を教えてもらうゲームの作者であるうえぞうと申します。

Internet Explorerは使われる機会が減ってきたものの、ExcelからスクレイピングをするにはCOM経由で直接操作できるのでとても便利でありました。今はExcelからだとSeleniumBasicを使ってChromiumを操作するのが主流だと思いますが、会社のパソコンだと自由にインストールできなかったりするので困っている人もそれなりに多くいらっしゃるかと思います。

そこで今回はVBAからSeleniumBasicをインストールすることなく、VBAから直接ChromeやEdge（のWebDriver）を操作する方法をシェアしたいと思います。

Seleniumの仕組み

誤解を恐れずに超ざっくり説明すると、ブラウザーを動かすのはWebDriverという部品で、さらにこのWebDriverに対して指示を出しているのがSeleniumBasicだったりその他Seleniumのバインディングです。そしてこのSeleniumBasic→WebDriverの間のやりとりは一般的なHTTP通信により行われています。

VBA −COM→ SeleniumBasic −HTTP→ WebDriver → ブラウザ

したがって、わざわざSeleniumBasicを使わなくても、Excel VBAから直接WebDriverを操作することが可能です。

VBA −HTTP→ WebDriver → ブラウザ

事前準備

ブラウザを操作するためのWebDriverと、HTTP通信で扱うデータフォーマット変換用にJsonConverterを準備します。また便利なデータ型も使いたいので参照設定も行います。
なお事前準備のさらに事前に、Excelファイルをマクロ有効の状態にしてVisual Basic Editorを開いておいてください。

WebDriverの入手

ブラウザに合わせて以下から入手します。注意すべき点として、ブラウザのバージョンとWebDriverのバージョンは同じにしないと動作しません。

• Chrome: https://chromedriver.chromium.org/downloads
• Edge: https://developer.microsoft.com/ja-jp/microsoft-edge/tools/webdriver/

JsonConverterの入手

VBA・WebDriver間の通信はJSONでのやりとりになりますので、JSONエンコード・デコードのためのライブラリを入手します。以下から「Source code」をダウンロードして解凍するとJsonConverter.basが入っていますので、これをVBAのプロジェクトに追加すればOKです。

Microsoft Scripting Runtimeの参照設定

連想配列を扱うDictionary型を利用するため、VBEのメニューバー ツール＞参照設定 からMicrosoft Scripting Runtimeにチェックを入れてください。先の手順で導入したJsonConvertはJSONとDictionaryを相互に変換してくれるため、使えるようにしておいた方が便利です。

ブラウザを起動する

では早速やってみましょう。流れとしては司令塔のWebDriverを開いて、WebDriverに対してChromeを開くよう指示します。冒頭のchromedriver.exeのパスは実際の場所のもので置き換えてください。Edgeなど別のブラウザの場合はそのWebDriverのパスになります。
なおコードの記述先ですが、プロジェクトに標準モジュールを追加してそこに書いていけば大丈夫です。

Sub Main()
    ' WebDriverの起動。デフォルトで9515番ポートを監視
    Shell "C:¥path¥to¥chromedriver.exe", vbMinimizedNoFocus

    ' ブラウザ起動パラメータの作成
    Dim params as New Dictionary
    params.Add "capabilities", New Dictionary
    params.Add "desiredCapabilities", Nothing

    ' HTTPクライアントの起動
    Dim client As Object
    Set client = CreateObject("MSXML2.ServerXMLHTTP")

    ' 指示の送信
    client.Open "POST", "http://localhost:9515/session"
    client.setRequestHeader "Content-Type", "application/json"
    client.send JsonConverter.ConvertToJson(params)

    ' 送信完了待ち
    Do While client.readyState < 4
        DoEvents
    Loop
End Sub

これを実行するとブラウザが空のページで開くと思います。もし開かない場合は、ブラウザのバージョンとWebDriverのバージョンが一致していることを確認してください。繰り返しになりますが異なると動きません。

URLを開く

WebDriverに指示を送れることが確認できたので、今度は特定のURLへの遷移を試してみます。先程の手順のコードに以下を追加します。
流れとしては、先の手順で開いたブラウザを特定するためのキー情報「sessionId」を控えておき、これを使って当該ブラウザにURLを開くよう指示します。これを実行するとGoogleで検索ボックスに「cat」と入力された画面が開きます。

    ' 送信完了待ち
    Do While client.readyState < 4
        DoEvents
    Loop

    ' 🌟ここから追加 ======================

    ' ブラウザ起動処理の戻り値からSessionIdを取得
    Dim sessionId As String
    sessionId = JsonConverter.ParseJson(client.responseText)("value")("sessionId")

    ' URL遷移用のパラメータを定義
    Dim navparams as New Dictionary
    navparams.Add "url", "https://www.google.co.jp/?q=cat"

    ' セッションIDを指定してURL遷移を指示
    client.Open "POST", "http://localhost:9515/session/" + sessionId + "/url"
    client.setRequestHeader "Content-Type", "application/json"
    client.send JsonConverter.ConvertToJson(navparams)

    ' 送信完了待ち
    Do While client.readyState < 4
        DoEvents
    Loop
End Sub

開きましたでしょうか？もしネコチャンの画像が見たい場合は、開いた画面でエンターキーを一発叩き込んでください。

リクエスト処理の共通部品化

ここまででもお分かりになったかと思いますが、全ての操作をHTTP経由で送ることになりますので、リクエスト送信部分は共通化した方が何かと便利です。

Private Function SendRequest(method As String, url As String, Optional data As Dictionary = Nothing) As Dictionary
    ' クライアントの起動
    Dim client As Object
    Set client = CreateObject("MSXML2.ServerXMLHTTP")

    ' メソッドに応じてリクエスト送信
    client.Open method, url
    If method = "POST" Or method = "PUT" Then
        client.setRequestHeader "Content-Type", "application/json"
        client.send JsonConverter.ConvertToJson(data)
    Else
        client.send
    End If

    ' 送信完了待ち
    Do While client.readyState < 4
        DoEvents
    Loop

    ' レスポンスをDictionaryに変換してリターン
    Dim Json As Object
    Set Json = JsonConverter.ParseJson(client.responseText)
    Set SendRequest = Json
End Function

これを作ることによって、ブラウザを開いてURLに遷移する処理の全体は以下のようになります。

Sub Main()
    ' WebDriverの起動。デフォルトで9515番ポートを監視
    Shell "C:¥path¥to¥chromedriver.exe", vbMinimizedNoFocus

    ' ブラウザ起動パラメータの作成
    Dim params As New Dictionary
    params.Add "capabilities", New Dictionary
    params.Add "desiredCapabilities", Nothing

    ' ブラウザ起動
    Dim sessionId As String
    sessionId = SendRequest("POST", "http://localhost:9515/session", params)("value")("sessionId")

    ' URL遷移用のパラメータを定義
    Dim navparams As New Dictionary
    navparams.Add "url", "https://www.google.co.jp/?q=cat"

    ' 遷移
    SendRequest "POST", "http://localhost:9515/session/" + sessionId + "/url", navparams
End Sub

だいぶスッキリしましたね！

画面要素の取得

さて、ここからが本番です。スクレイピングというのは基本的に 1.画面の要素を取得する、2.取得した要素に対して何かする、の2段階の処理で構成されています。まずは一つ目の画面要素の取得は以下のようになります。先のスッキリしたコードの末尾に追加しましょう。

    ' 検索テキストボックスを取得するためのパラメータを準備（name属性がq）
    Dim elmparams As New Dictionary
    elmparams.Add "using", "css selector"
    elmparams.Add "value", "[name=""q""]"

    ' 検索テキストボックスを取得して`elementId`に控えておく
    Dim elementId As String
    elementId = SendRequest("POST", "http://localhost:9515/session/" + sessionId + "/element", elmparams)("value")("element-6066-11e4-a52e-4f735466cecf")
    
    ' 取得結果を表示
    Debug.Print elementId
End Sub

これを実行すると、取得した検索テキストボックスのIDがイミディエイトウィンドウに表示されます。

e5ea131b-b2fc-49d6-91aa-9abaf633418e

この値e5ea131b-b2fc-49d6-91aa-9abaf633418eを使ってDOMにおける要素を一意に特定することができ、値の入出力やクリックなどの操作が行えると言うわけです。
なおコード中で指定しているキーelement-6066-11e4-a52e-4f735466cecfというのは、要素のIDを示す固定のキー文字列です。

値の取得・入力・クリック

先の手順で取得したelementIdを使って、画面項目に対する操作をしていきます。なおここに挙げた3つの処理以外もやり方は同じで、メソッド・エンドポイントURL・パラメータを変更すればOKです。

値の取得

まずは検索ボックスの値を取得してみます。DOMを生で触るときのようにvalueプロパティを取得するためのAPIが用意されているわけではなく、汎用的に属性の値を取得するAPIに属性名であるvalueを指定します。

    Dim searchValue As String
    searchValue = SendRequest("GET", "http://localhost:9515/session/" + sessionId + "/element/" + elementId + "/attribute/value")("value")

    Debug.Print searchValue
End Sub

これを実行するとcatが出力されると思います。

値の入力

次に値の入力をやってみましょう。値の入力はvalue属性の直接的な書き換えではなく、キーボード入力を送信することになります。単に値を入力する場合はvalue属性の設定は不要ですが、特殊なキーストロークを送る際には必要になります。

    Dim text As String
    text = "猫 サバトラ白"

    ' 1文字ずつに区切る
    Dim chars() As String
    ReDim chars(Len(text) - 1)
    Dim i As Integer
    For i = 0 To UBound(chars)
        chars(i) = Mid(text, i + 1, 1)
    Next

    ' 値入力用のパラメータを準備
    Dim valparams As New Dictionary
    valparams.Add "text", text
    valparams.Add "value", chars

    ' 既に入力されているcatを消す
    SendRequest "POST", "http://localhost:9515/session/" + sessionId + "/element/" + elementId + "/clear", New Dictionary

    ' 値入力の指示
    SendRequest "POST", "http://localhost:9515/session/" + sessionId + "/element/" + elementId + "/value", valparams
End Sub

これを実行すると、開いてすぐに検索ボックスが「cat」から「猫　サバトラ白」に書き換えられると思います。もしサバトラ白のネコチャンの画像が見たい場合は、開いた画面でエンターキーを一発叩き込んでください。

ボタンのクリック

エンターキーを叩かなくてもいきなりサバトラ白の検索結果を表示するために、ボタンのクリックも自動化していきます。

    ' 検索ボタン取得のパラメータの準備（name属性がbtnK）
    Dim btnelmparams As New Dictionary
    btnelmparams.Add "using", "css selector"
    btnelmparams.Add "value", "[name=""btnK""]"

    ' 検索ボタンを取得して`elementId`に控えておく
    Dim btnElementId As String
    btnElementId = SendRequest("POST", "http://localhost:9515/session/" + sessionId + "/element", btnelmparams)("value")("element-6066-11e4-a52e-4f735466cecf")

    ' 検索ボタンをクリック
    SendRequest "POST", "http://localhost:9515/session/" + sessionId + "/element/" + btnElementId + "/click", New Dictionary
End Sub

これでめでたくサバトラ白ちゃんをすぐに拝めるようになったかと思います。もしエラーになる場合には、最後のSendRequestのところにブレイクポイントを設定して2秒くらい待ってから処理を継続するなどしてください。これは検索ボタンが操作可能でないときにクリック指示を出してしまっていることが原因で、この回避方法についてはまた別途記事にしたいと思います。

コード全体

継ぎ足しの説明になりましたので、最後に一連の処理を載せておきます。

Sub Main()
    ' WebDriverの起動。デフォルトで9515番ポートを監視
    Shell "C:\Users\uezo\Desktop\edgedriver_win64\msedgedriver.exe", vbMinimizedNoFocus

    ' ブラウザ起動パラメータの作成
    Dim params As New Dictionary
    params.Add "capabilities", New Dictionary
    params.Add "desiredCapabilities", Nothing

    ' ブラウザ起動
    Dim sessionId As String
    sessionId = SendRequest("POST", "http://localhost:9515/session", params)("value")("sessionId")

    ' URL遷移用のパラメータを定義
    Dim navparams As New Dictionary
    navparams.Add "url", "https://www.google.co.jp/?q=cat"

    ' 遷移
    SendRequest "POST", "http://localhost:9515/session/" + sessionId + "/url", navparams

    ' 検索テキストボックスを取得するためのパラメータを準備（name属性がq）
    Dim elmparams As New Dictionary
    elmparams.Add "using", "css selector"
    elmparams.Add "value", "[name=""q""]"

    ' 検索テキストボックスを取得して`elementId`に控えておく
    Dim elementId As String
    elementId = SendRequest("POST", "http://localhost:9515/session/" + sessionId + "/element", elmparams)("value")("element-6066-11e4-a52e-4f735466cecf")

    ' 取得結果を表示
    Dim searchValue As String
    searchValue = SendRequest("GET", "http://localhost:9515/session/" + sessionId + "/element/" + elementId + "/attribute/value")("value")
    Debug.Print searchValue

    ' 検索キーワードを準備
    Dim text As String
    text = "猫 サバトラ白"

    ' 1文字ずつに区切る
    Dim chars() As String
    ReDim chars(Len(text) - 1)
    Dim i As Integer
    For i = 0 To UBound(chars)
        chars(i) = Mid(text, i + 1, 1)
    Next

    ' 値入力用のパラメータを準備
    Dim valparams As New Dictionary
    valparams.Add "text", text
    valparams.Add "value", chars

    ' 既に入力されているcatを消す
    SendRequest "POST", "http://localhost:9515/session/" + sessionId + "/element/" + elementId + "/clear", New Dictionary

    ' 値入力の指示
    SendRequest "POST", "http://localhost:9515/session/" + sessionId + "/element/" + elementId + "/value", valparams

    ' 検索ボタン取得のパラメータの準備（name属性がbtnK）
    Dim btnelmparams As New Dictionary
    btnelmparams.Add "using", "css selector"
    btnelmparams.Add "value", "[name=""btnK""]"

    ' 検索ボタンを取得して`elementId`に控えておく
    Dim btnElementId As String
    btnElementId = SendRequest("POST", "http://localhost:9515/session/" + sessionId + "/element", btnelmparams)("value")("element-6066-11e4-a52e-4f735466cecf")

    ' 検索ボタンをクリック
    SendRequest "POST", "http://localhost:9515/session/" + sessionId + "/element/" + btnElementId + "/click", New Dictionary
End Sub

WebDriver操作コマンドの仕様（W3C）

ここまで「このエンドポイントにこんなパラメータをPOSTして〜」と書いてきましたが、一体どこで調べたのか？他の処理をするにはどうやって調べれば良いのか？という疑問を抱かれたかと思います。

実はこれらの仕様はW3CというWeb技術の標準を決めている団体によって定義されているようで、ここを見れば仕様がわかります。
https://www.w3.org/TR/webdriver/

とはいえ正直仕様を読み取るのが難しかったので、私はPython製のSeleniumバインディングのソースコードを読み解いてVBAに読み替えました。途中で書きましたように何をするにもやり方は一律ですので、エンドポイントとパラメータの内容だけ調べれば簡単に移植できると思います。

ピュアVBAなSeleniumクライアント「TinySeleniumVBA」

WebDriverすべてのコマンドをラッピングすることはせず、よく使うコマンドやAPI呼び出しの簡易化など必要最小限の機能を持つピュアVBAなSeleniumクライアントを作りました。

これを使うと本記事と同等の処理がさらに簡単に書けるようになります。

Public Sub main()
    ' Start WebDriver (Edge)
    Dim Driver As New WebDriver
    Driver.Edge "path\to\msedgedriver.exe"
    
    ' Open browser
    Driver.OpenBrowser
    
    ' Navigate to Google
    Driver.Navigate "https://www.google.co.jp/?q=cat"

    ' Get search textbox
    Dim searchInput
    Set searchInput = Driver.FindElement(By.Name, "q")
    
    ' Get value from textbox
    Debug.Print searchInput.GetValue
    
    ' Set value to textbox
    searchInput.SetValue "猫 サバトラ白"
    
    ' Click search button
    Driver.FindElements(By.Name, "btnK")(1).Click
End Sub

なおやりたい方が多そうなヘッドレスモード（ブラウザ非表示モード）にするには、Capabilitiesオブジェクトを作ってSetArgumentsし、それをDriver.OpenBrowserに渡せばオッケーです👍

' Start web driver
Dim Driver As New WebDriver
Driver.Chrome "C:\path\to\chromedriver.exe"

' Configure Capabilities
Dim cap As Capabilities
Set cap = Driver.CreateCapabilities()
cap.SetArguments "--headless"   ' 他にもオプションあれば半角スペース区切りで指定

' Capabilitiesの中身をJSON形式で確認することもできます
Debug.Print cap.ToJson()

' Open browser
Driver.OpenBrowser cap

またブラウザ上でのJavaScriptの実行も簡単にできます。VBAでやると複雑になる場合はブラウザ側で実行してしまうのも良いと思います。

' Start web driver
Dim Driver As New WebDriver
Driver.Chrome "C:\path\to\chromedriver.exe"

' Open browser
Driver.OpenBrowser

' Navigate to Google
Driver.Navigate "https://www.google.co.jp/?q=liella"

' Show alert
Driver.ExecuteScript "alert('Hello TinySeleniumVBA')"

' === Use breakpoint to CLOSE ALERT before continue ===

' Pass argument
Driver.ExecuteScript "alert('Hello ' + arguments[0] + ' as argument')", Array("TinySeleniumVBA")

' === Use breakpoint to CLOSE ALERT before continue ===

' Pass element as argument
Dim searchInput
Set searchInput = Driver.FindElement(By.Name, "q")
Driver.ExecuteScript "alert('Hello ' + arguments[0].value + ' ' + arguments[1])", Array(searchInput, "TinySeleniumVBA")

' === CLOSE ALERT and continue ===

' Get return value from script
Dim retStr As String
retStr = Driver.ExecuteScript("return 'Value from script'")
Debug.Print retStr

' Get WebElement as return value from script
Dim firstDiv As WebElement
Set firstDiv = Driver.ExecuteScript("return document.getElementsByTagName('div')[0]")
Debug.Print firstDiv.GetText()

' Get complex structure as return value from script
Dim retArray
retArray = Driver.ExecuteScript("return [['a', '1'], {'key1': 'val1', 'key2': document.getElementsByTagName('div'), 'key3': 'val3'}]")

Debug.Print retArray(0)(0)  ' a
Debug.Print retArray(0)(1)  ' 1

Debug.Print retArray(1)("key1") ' val1
Debug.Print retArray(1)("key2")(0).GetText()    ' Inner Text
Debug.Print retArray(1)("key2")(1).GetText()    ' Inner Text
Debug.Print retArray(1)("key3") ' val3

よかったら使ってみてください。気に入ってくれたらスター🌟してもらえると嬉しいです！