chromeのスクレイピング結果をエクセルへ渡す方法【VBA, chrome拡張機能】

やりたいこと

エクセルからブラウザにアクセスをし、処理結果をエクセルに返却する。

前提条件

Chrome、VBAは使用可能
その他、外部サイトからのインストール行為はNG
つまり、Selenium, WebDriverなどのライブラリは使用不可

全体の流れ

VBA : Chromeのタブを開く。
Chrome拡張機能 : 必要なデータを収集する。
Chrome拡張機能 : 収集データをクリップボードをに設定する。
VBA : クリップボードから収集データを取得する。（データが設定されるまでは待機する。）

実装コード

VBA

' 呼び出し側の処理
Public Sub Main()
    Dim browser As New browser
    Dim url As String
    url = "https://www.db.yugioh-card.com/yugiohdb/card_search.action"
    
    Dim response As BrowserResponse
    With browser
        Call .SetUrl(url)
        Call .AddParam("ope", "2")
        Call .AddParam("cid", "4410")
        Call .AddParam("AutoMode", "")
        Set response = .Launch
    End With
    
    If (response.isCompleted = True) Then
        Debug.Print (response.data("攻撃力"))
        Debug.Print (response.data("守備力"))
        Set browser = Nothing
    End If
End Sub

' 参照設定
' Windows Script Host Object Model
' 　: バッチクラス
' Microsoft Scripting Runtime
' 　: Dictionary

Private mUrl As String
Private mParams As Dictionary

' コンストラクタ
Private Sub Class_Initialize()
    Set mParams = New Dictionary
End Sub

' デストラクタ
Private Sub Class_Terminate()
    Set mParams = Nothing
End Sub

' Setter: url
Public Sub SetUrl(url As String)
    mUrl = url
End Sub

' Setter: Params
Public Sub AddParam(k As String, v As String)
    Call mParams.Add(k, v)
End Sub

' ブラウザを起動する。
Public Function Launch(Optional timeout As Long = 10000) As BrowserResponse

    ' コマンド実行
    Call ExecuteCommand
    
    ' レスポンス取得
    Dim response As New BrowserResponse
    Call response.Receive(timeout)
    Set Launch = response
End Function

' コマンドを生成する
Private Function CreateCommand() As String
    Const BROWSER_EXE_PATH As String = "C:\Program Files (x86)\Google\Chrome\Application\chrome.exe"
    
    ' クォーテーション
    Dim QUOT As String
    QUOT = Chr(34)
    
    ' クエリ結合
    Dim joined_param As String
    joined_param = JoinParam(mParams)
                
    ' URL結合
    ' command : ""(略)chrome.exe" "https://...?p=v""
    Dim command As String
    command = QUOT _
               & QUOT & BROWSER_EXE_PATH & QUOT _
               & " " _
               & QUOT & mUrl & joined_param & QUOT _
               & QUOT
    CreateCommand = command
End Function

' コマンドを実行する
Private Function ExecuteCommand()
    ' コマンド生成
    Dim command As String
    command = CreateCommand
    
    ' 実行
    Dim wsh As New IWshRuntimeLibrary.WshShell
    Dim result As WshExec
    Set result = wsh.Exec("%ComSpec% /c " & command)
    Set wsh = Nothing
End Function

' url形式に結合したパラメータを返却する
Private Function JoinParam(params As Dictionary) As String
    If (params.Count = 0) Then
        JoinParam = ""
        Exit Function
    End If
    
    ' パラメータ結合
    Dim p As String
    p = "?"
    Dim key As Variant
    For Each key In params
        p = p & key & "=" & params.Item(key)
        p = p & "&"
    Next
    ' 末尾の不要な&を削除
    p = Left(p, Len(p) - 1)
    JoinParam = p
End Function

Private mIsCompleted As Boolean
Private mStatus As String
Private mMessage As String
Private mData As Dictionary

' コンストラクタ
Private Sub Class_Initialize()
End Sub

' デストラクタ
Private Sub Class_Terminate()
End Sub

' Getter
Public Property Get isCompleted() As Boolean
    isCompleted = mIsCompleted
End Property

Public Property Get status() As String
    status = mStatus
End Property

Public Property Get message() As String
    message = mMessage
End Property

Public Property Get data() As Dictionary
    Set data = mData
End Property

' レスポンスを取得する
Public Sub Receive(timeout As Long)
    
    ' レスポンスクリア
    Call Clipboard.SetClipboardData("")

    Dim t As Double
    t = Timer
    ' レスポンスが取得できるまで待機する
    Do While ((Timer - t) * 1000 < timeout)
        ' クリップボードの取得と設定が競合時エラーに対応
        On Error GoTo WAITING
        Dim raw_data As String
        raw_data = Clipboard.GetClipboardData
        If (raw_data Like "RECEIVED*") Then
            Call Parse(True, raw_data)
            Exit Sub
        End If
WAITING:
        Debug.Print (Timer - t) * 1000
        Call SafetySleep(50)
    Loop
    Call Parse(False, "")
End Sub

' レスポンスデータをパースする
Private Sub Parse(is_completed As Boolean, raw_data As String)
    Dim lines() As String
    lines = Split(raw_data, vbCrLf)
        
    mIsCompleted = is_completed
    If (is_completed = False) Then
        Exit Sub
    End If
    
    mStatus = lines(1)
    mMessage = lines(2)
    
    Dim dic As New Dictionary
    Dim params() As String
    params = Split(lines(3), "&")
    Dim p As Variant
    For Each p In params
        Dim kv() As String
        kv = Split(p, "=")
        Call dic.Add(kv(0), kv(1))
    Next
    Set mData = dic
End Sub

' 参照設定
' Microsoft Forms 2.0 Object Library
' C:\Windows\SysWOW64\FM20.DLLを追加する。

' 設定
Public Sub SetClipboardData(str As String)
    Dim dObj As New DataObject
    dObj.SetText (str)
    Call dObj.PutInClipboard
    Set dObj = Nothing
End Sub

'
' 取得
'
Public Function GetClipboardData() As String
    Dim dObj As New DataObject
    Call dObj.GetFromClipboard
    GetClipboardData = dObj.GetText
    Set dObj = Nothing
End Function

Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)

Public Sub SafetySleep(ms As Long)
    DoEvents
    Call Sleep(ms)
End Sub

Chrome拡張機能

{
    "manifest_version": 3
    , "version": "1.0"
    , "name": "カード情報取得"
    , "description": "カード情報を非同期で取得する。"

    , "content_scripts":[
        {
            "matches": ["https://www.db.yugioh-card.com/yugiohdb/card_search.action*AutoMode*"]
            , "js": ["response.js", "get_card_detail.js"]
            , "run_at":"document_end"
        }
    ]
}

async function main() {
    const container = document.querySelectorAll('.item_box');
    const attack = container[2].innerText.split('\n')[1];
    const defense = container[3].innerText.split('\n')[1];

    const response = new Response();
    response.setStatus('SEARCHED');
    response.setMessage('message nothing');
    response.addData('攻撃力', attack);
    response.addData('守備力', defense);
    await response.receive();
}

main();

/**
 * レスポンスデータ
 * データはクリップボード経由で返却する
 */
class Response {
    // ステータス、メッセージ、データはいずれも任意
    // 返却先の必要に応じて設定する
    #mStatus
    #mMessage;
    #mData = [];
    
    // Setter
    setStatus(status) {
        this.#mStatus = status;
    }
    setMessage(message){
        this.#mMessage = message;
    }
    addData(key, value) {
        this.#mData.push(key + '=' + value);
    }
    
    // データを返却する
    async receive() {
        const HEADER = 'RECEIVED';
        const NEWLINE = '\r\n';
        let str = HEADER + NEWLINE;
        str += this.#mStatus + NEWLINE;
        str += this.#mMessage + NEWLINE;
        str += this.#mData.join('&');
        await navigator.clipboard.writeText(str);
    }
}

コード解説

処理の流れ

VBA

Thisworkbook

Browserクラスでブラウザを開き、処理結果をBrowserResponseクラスとして取得します。

実行時のurlは「https://www.db.yugioh-card.com/yugiohdb/card_search.action?ope=2&cid=4410&AutoMode=」。opeとcidはカード検索時に必要な情報であって、他サイトをアクセスする際には不要です。

AutoModeは必須です。AutoModeを付けることでChrome側ではVBAからアクセスされた場合にのみ拡張機能を実行することができます。manifest.jsonのmatchesと一致していればキー名は何でも構いません。

        Call .AddParam("AutoMode", "")

    , "content_scripts":[
        {
            "matches": ["https://www.db.yugioh-card.com/yugiohdb/card_search.action*AutoMode*"]

Browser

URLをコマンドプロンプトに渡してブラウザを開きます。

URLを構築する際はダブルクォーテーションを必ずつけるように気を付けます。

コマンドプロンプトでは空白の後ろは引数として認識されてしまうので

「C:\Program Files (x86)\Google\Chrome\Application\chrome.exe」の場合

「C:\Program」がexeファイルまでのパス。「Files (x86)\Google\Chrome\Application\chrome.exe」がその引数として扱われます。

' URL結合
' command : ""(略)chrome.exe" "https://...?p=v""
Dim command As String
command = QUOT _
　　　& QUOT & BROWSER_EXE_PATH & QUOT _
　　　& " " _
　　　& QUOT & mUrl & joined_param & QUOT _
　　　& QUOT

BrowserResponse

　　' レスポンスクリア
    Call Clipboard.SetClipboardData("")

前回のレスポンスデータがクリップボードに残っていた場合、それが結果として取得されてしまうためクリアにしておく必要があります。

        On Error GoTo WAITING
WAITING:

クリップボードから値を取得する際、エラーが発生することがあります。具体的にはVBAからの値の取得と、Chrome側での値の設定を同時に行おうとして競合が起こり「オートメーションエラーです。OpenClipboardに失敗しました。」というメッセージと共にエラーとなります。

そのため、競合が発生せず、結果を取得できるまで繰り返し処理を行います。

        Call SafetySleep(50)

Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)

Public Sub SafetySleep(ms As Long)
    DoEvents
    Call Sleep(ms)
End Sub

VBAが負荷を掛けすぎないよう、待機処理を入れています。

Sleepを使用しているのは、完全な個人の好みなのでApplication.Wait()に置き換えてしまっても問題ありません。

Clipboard

クリップボードから値を取得、値の設定を実装しています。

「vba Clipboard 値取得」などで検索するといくらでもサンプルが出てきますし、特段説明することもないでしょう。

Chrome拡張機能

get_card_detail

　　const container = document.querySelectorAll('.item_box');
    const attack = container[2].innerText.split('\n')[1];
    const defense = container[3].innerText.split('\n')[1];

遊戯王公式HPのカード情報から「攻撃力」と「守備力」の数値を取得しています。

あくまでもサンプルなので、この情報をどう活用するかなどの目的はありません。

receive

    // データを返却する
    async receive() {
        const HEADER = 'RECEIVED';
        const NEWLINE = '\r\n';
        let str = HEADER + NEWLINE;
        str += this.#mStatus + NEWLINE;
        str += this.#mMessage + NEWLINE;
        str += this.#mData.join('&');

‘RECEIVED’ : VBA側でレスポンスが発生したかを判別するための識別子。
mStatus ：処理結果を表す文字列。例えば一覧検索の場合「”DATA_EXIST”」「”NO_DATA”」などを設定して、VBA側での分岐処理に利用する。
message：エラーメッセージなどの設定。
data：map形式のデータ。サンプルでは「攻撃力=XXXX&守備力=XXXX」の形式で設定される。

        await navigator.clipboard.writeText(str);

クリップボード API の全てのメソッドは非同期で動作します。それらはクリップボードにアクセスできたときに解決されるプロミス（Promise オブジェクト）を返します。このプロミスは、クリップボードへのアクセスが拒否された場合には拒否されます。

awaitを付けないと、VBAとの競合により、クリップボードに値を設定できずにそのまま処理を終了してしまいます。

引用文には、「値が設定されるまで待機する」という記載なく確証は取れていませんが、動作確認をする限りではawaitの記述により、確実にクリップボードへ値を設定することができています。

注意点

Chromeのセキュリティ

セキュリティの観点でChrome側でクリップボードにアクセスをしようとすると以下の認証が求められます。

一度認証をしてしまえば、少なくともブラウザが開いている間は、再度認証を求められることはありません。

クリップボードの参照条件

おそらくセキュリティの観点からか、クリップボードへアクセスをするためには、ブラウザにフォーカスが当たっている必要があります。

例えば、VBAからブラウザを開き、その直後にデスクトップをクリックした場合（ブラウザのフォーカスが失われた場合）

Uncaught DOMException: Document is not focused.

というエラーが発生します。

今回のサンプルではこのエラーの対策をしていませんが、修正をするとしたら

クリップボード参照時、例外が発生したら握り潰し、タイムアウトするまで参照を繰り返す。
一定期間ごとにブラウザをアクティブにする。(もしかしたらBackground.jsが必要になるかもしれません。)

まとめ

クリップボードを仲介することでVBA – Chrome間でのデータ渡しができる。
VBAとChromeでデータ構造を統一できていれば、どのようなデータでも渡すことができる。
Chromeにアクセスをすると、一度だけクリップボードへのアクセス許可の認証が求められる。
正常に動作するためにはChromeにフォーカスが当たっている必要がある。（処理が完了するまではマウスのクリックをしないほうが良い）

えんすく！

まったりプログラミング

chromeのスクレイピング結果をエクセルへ渡す方法【VBA, chrome拡張機能】

やりたいこと

前提条件

全体の流れ

実装コード

VBA

Chrome拡張機能

コード解説

処理の流れ

VBA

Thisworkbook

Browser

BrowserResponse

Clipboard

Chrome拡張機能

get_card_detail

receive

注意点

Chromeのセキュリティ

クリップボードの参照条件

まとめ