【ExcelVBA】Web情報でシートを作成しリンクを貼る【Seleniumなしでスクレイピング】【Firefox】Part1

  • [記事公開]2023.02.07[最終更新]2023.02.11
  • VBA

私は昔Web上の知見者たちに大いに助けてもらったことがありまして、時間のできた今その恩返しをしようと、ある質問掲示板の質問に答えることを日課しています。

今回その一つに答えようと調べ始めたら、これがなかなかやっかいだということが分かりまして、全部が完成したら一度に記事にしようと思っていたのですが、全部できるまでどれくらいかかるか分からないし、何回かに分けて記事にしようと思います。

今回はその第1回目です。

質問

質問は下記のとおりです。

https://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q13274674623

自身のYAHOO IDでログインをし、添付のようにYAHOO JAPANトップから
赤枠のニュース蘭をカテゴリ別にシートをVBAにて自動生成して
それぞれのシートに右図のようなニュース文字列を表示し、さらにリンクを付けて
クリックしたらそれぞれのYAHOOページに飛ぶようなマクロを
FIREFOXブラウザ(※IEじゃないです)にて行いたいです。

ニュース表示内容はログインIDに依存しないかとは思われますが、なかなか
ログインできず苦戦しています。もちろん現行のYAHOOJAPANの仕様で
大丈夫です。宜しくお願いします。

https://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q13274674623

この中の「自身のYAHOO IDでログイン」については以前記事にしました。結論として、私は自動ログインはしません。できるかもしれないけどしたくないです。ごめんなさい。セキュリティ上問題があるので、それはしたくないのです。

トップページからトピックスのニュース一覧をカテゴリ別にExcelのワークシートを自動生成してリンクを貼るについて、これから何回かに分けて記事にしていこうと思います。

VBAでFirefoxを操作するには

VBAでFireFoxを操作する方法については、以前記事にしました。

事前準備としていろいろ必要です。

事前準備がすべて完了している前提で話を進めていきますので、悪しからず。

ローカルホストを開いてWebdriverでセッションを開き、Yahoo!のトップページまでは開いているという状態から本題を始めます。

コードで言うと、次のとおりです。

Sub YahooTopからカテゴリ別にシートを自動生成しリンクを貼る()
    'Webdriverの起動。Firefoxはデフォルトで4444番ポートを監視
    Shell "C:\Webdrivers\geckodriver.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")
    
    'ブラウザ起動(デバッグ時に確認しやすいよう、こまめに変数に拾っていく方針)
    Const cstLocalhost As String = "http://localhost:4444/session"
    Dim oBuf As Object
    Set oBuf = SendRequest(client, "POST", cstLocalhost, params)
    
    'ブラウザ起動処理の戻り値からSessionIdを取得
    Dim sessionId As String
    sessionId = oBuf("value")("sessionId")

    'URL遷移用のパラメータを定義
    Set params = New Dictionary
    Const cstYahooUrl As String = "https://www.yahoo.co.jp/"
    params.Add "url", cstYahooUrl

    '遷移
    SendRequest client, "POST", cstLocalhost & "/" + sessionId + "/url", params
    
    'タブトピックスを探すためのパラメータを準備←ここから始めます。

本題 – tabtopicsの情報をゲットする

どうやってニュース記事一覧のタブをゲットするか

Topのニュース記事一覧のタブ(図の赤線枠)は、F12で開発者ツールで見ると、tabtopicsと言うらしいです。

この部分のHTMLを見てみると、こんな風になっていました。

<ul class="_3Ycrll4SYlmOz2rU8bzRr5" role="tablist" aria-label="Yahoo!ニュースのカテゴリ">
<li id="tabTopics1" class="_3bryYR6xkbIHcdZdbybgnd ENXbYBReWSw0fU0fDUlIP" role="tab" aria-selected="true" aria-controls="tabpanelTopics1">
<a class="_1fWTm2E47ymhMM3suCaCGi _3aR1Wl7JOyOEug4F-C-ZyI cl-nofollow" data-cl-params="_cl_vmodule:tpto;_cl_link:tab;_cl_position:0;type:link" href="https://news.yahoo.co.jp/" data-cl_cl_index="1">ニュース</a></li>
<li id="tabTopics2" class="_3bryYR6xkbIHcdZdbybgnd ENXbYBReWSw0fU0fDUlIP" role="tab" aria-selected="false">
<a class="_1fWTm2E47ymhMM3suCaCGi cl-nofollow" data-cl-params="_cl_vmodule:tpec;_cl_link:tab;_cl_position:0;type:switch" href="https://news.yahoo.co.jp/categories/business" data-cl_cl_index="2">経済</a></li>
<li id="tabTopics3" class="_3bryYR6xkbIHcdZdbybgnd ENXbYBReWSw0fU0fDUlIP" role="tab" aria-selected="false">
<a class="_1fWTm2E47ymhMM3suCaCGi cl-nofollow" data-cl-params="_cl_vmodule:tpen;_cl_link:tab;_cl_position:0;type:switch" href="https://news.yahoo.co.jp/categories/entertainment" data-cl_cl_index="3">エンタメ</a></li>
<li id="tabTopics4" class="_3bryYR6xkbIHcdZdbybgnd ENXbYBReWSw0fU0fDUlIP" role="tab" aria-selected="false">
<a class="_1fWTm2E47ymhMM3suCaCGi cl-nofollow" data-cl-params="_cl_vmodule:tpsp;_cl_link:tab;_cl_position:0;type:switch" href="https://news.yahoo.co.jp/categories/sports" data-cl_cl_index="4">スポーツ</a></li>
<li id="tabTopics5" class="_3bryYR6xkbIHcdZdbybgnd ENXbYBReWSw0fU0fDUlIP" role="tab" aria-selected="false">
<a class="_1fWTm2E47ymhMM3suCaCGi cl-nofollow" data-cl-params="_cl_vmodule:tpdo;_cl_link:tab;_cl_position:0;type:switch" href="https://news.yahoo.co.jp/categories/domestic" data-cl_cl_index="5">国内</a></li>
<li id="tabTopics6" class="_3bryYR6xkbIHcdZdbybgnd ENXbYBReWSw0fU0fDUlIP" role="tab" aria-selected="false">
<a class="_1fWTm2E47ymhMM3suCaCGi cl-nofollow" data-cl-params="_cl_vmodule:tpun;_cl_link:tab;_cl_position:0;type:switch" href="https://news.yahoo.co.jp/categories/world" data-cl_cl_index="6">国際</a></li>
<li id="tabTopics7" class="_3bryYR6xkbIHcdZdbybgnd ENXbYBReWSw0fU0fDUlIP" role="tab" aria-selected="false" style="min-width:59px">
<a class="_1fWTm2E47ymhMM3suCaCGi cl-nofollow" data-cl-params="_cl_vmodule:tpit;_cl_link:tab;_cl_position:0;type:switch" href="https://news.yahoo.co.jp/categories/it" data-cl_cl_index="7">IT・科学</a></li>
<li id="tabTopics8" class="_3bryYR6xkbIHcdZdbybgnd ENXbYBReWSw0fU0fDUlIP" role="tab" aria-selected="false">
<a class="_1fWTm2E47ymhMM3suCaCGi cl-nofollow" data-cl-params="_cl_vmodule:tplc;_cl_link:tab;_cl_position:0;type:switch" href="https://news.yahoo.co.jp/categories/local" data-cl_cl_index="8">地域</a></li>
</ul>

いずれもrole=”tab”が入っていたり、tab;となっていたり、「tab」というのがキーワードになっていることが分かりました。

また、F12で検索してみると、tabというキーワードがひっかるのはこの付近だけというのも確認できました。

ということで、このtabtopicsを拾ってくるのは、tabというキーワードでよいかなーー?と思いました。

複数のエレメントを一度にとってくるには

複数のエレメントを一度にとってくるには、こちらのサイトによるとCSS selectorやtag nameを使って、FindElementsという機能を使えばよいということが分かりました。FindElementではなくFindElementsです。複数形。

具体的なコードは下記のとおりとなります。

client.Open "POST", url
client.setRequestHeader "Content-Type", "application/json"
client.Send JSON形式のパラーメータファイル

これだけ見ると何が違っているのか分かりませんね・・・。特徴的なのは、urlです。urlはテキスト文字列です。私の環境では次のように記述しました。

"http://localhost:4444/session/" + sessionId + "/elements"

この最後の部分がelementsとなっているのに注目。これにより、オブジェクトclientにresponsTextが返ってきたとき、値が一つでなく複数で返ってくることになります。

ポート番号

4444はポート番号です。使うWebdriverによって異なりますが、たいていのWebdriverに「このポートを使いたんじゃ!」と命令すれば好きなポート番号にすることができます。

ポート番号をどうやって変更したらよいかとか、Webdriverの使い方はヘルプを見てください。Webdriverのヘルプはコマンドプロンプトで、webdriver.exe –helpで調べることができます。

私が今回使うFirefoxのgeckodriver.exeのヘルプはこんな感じです。

たくさんあるのでスクロールして見てみると、geckodriver.exeの場合、–portでポート番号を変えることができるのですが、デフォルトが4444であると書いてありました。

私がC:\geckodriver.exeとだけでコマンドを使えているのは、Cドライブ直下にgeckodriver.exeがあるからではなく、PATHを通してあるからです。PATHを通してないのであれば、フルパスで記述する必要があります。PATHの通し方は「PATH Windows 通し方」でググってください(他力本願)。

セッションID

sessionIdというのは、通信に使うセッションのIDです。トートロジー的な説明ですみません(頭痛が痛い、音速のソニック、後で後悔する的な・・・)。でもホント、無知な私にはこういう風にしか説明できないです。

sessionIdをどうやって調べるかは、以前記事にしました。ほかの方も記事にしていますし、そちらをご参照ください(他力本願パート2)。

このセッションIDを調べるのもめんどくさいし、調べた後ずっとそのセッションIDを使い続けるのも煩わしいですよね。

今回Firefoxでという質問者さんのご要望があったのでWebdriverを使っていますが、多分このセッションIDは、Webdriverを使わないなら不要なんだと思います。

VBAはプログラムなんだから、人が目で見て確認するためのブラウザなんて使わず、ということはWebdriverも使わず、直接VBAからHTMLを読み込めばよいと思うのですが、この辺はもう少し調べてから記事にしようと思います。

JSON形式のパラーメータファイル

パラメータファイルはJSONで記述する必要があります。

JSONというのはJavascriptで使うファイル形式です(多分)。私はシステム屋ではないので、ぼやっとした知識しかもっていません。ふわっとした説明しかできないです。すみません。ちゃんと知りたい方はググってください(他力本・・・以下略)。

VBAでJSON形式のファイルを作成するには、すでに良ツールが公開されていますので、それを使ってください。JsonConverter.basっていうんですけどね。これもググって・・・・というにはあまりにも不親切だと思うのでリンクを貼っておきます。

https://github.com/VBA-tools/VBA-JSON/releases/tag/v2.3.1

↑こちらのツールを使うときは、VBEのツールの設定で、参照設定にMicrosofrt Scripting Runtimeにチェックを入れておく必要があります。

As Dictionaryという風に使いたいからです。

実際に使うときは、引数にDictionaryを用意します。

Dictionaryにはキーと値をセットで追加(Add)しておきます。

キーには使える値が決まっているようですが、私も詳しいことは知りません。

今回の例では次のように値を追加します。

    Dim params As New Dictionary
    params.Add "using", "css selector"
    params.Add "value", "[role=""tab""]" 

usingで使える選択肢は、こちらのサイトに書いてあります。

“[role=””tab””]”としたのは、tabtopicsのrole=”tab”となっている要素を抽出してきたいからです。

この部分はもっと別の良い指定の方法があるかもしれません。

このparamsというDictionaryをJSON形式にするには、JsonConverter.basにあるConvertToJsonというFunctionに渡してあげればよいです。

ということで、先ほどの「client.Send JSON形式のパラーメータファイル」の部分はこんな風に書き換えることができます。

client.Send JsonConverter.ConvertToJson(params)

ちなみに、このJSON形式のファイルがどうなっているか、デバッグ中にブレイクポイントを置いて中身を見てみましたところ、こんな感じになっていました。

{"using":"css selector","value":"[role=\"tab\"]"}

見づらいですね。見やすいように整形したのがこちらです。

{
"using":"css selector",
"value":"[role=\"tab\"]"
}

これがJSONと呼ばれるファイル形式です。

返り値の中にある複数の情報を取り出すには

FindElementsの機能を使って複数の情報を取りに行き、無事にゲットできたとして、それをどうやって取り出すかについて説明します。

JSON形式でSENDしていますので、戻ってくる情報もJSON形式です。

具体的には、client.responstextというところに値が入ってきます(clientというのはMSXML2.ServerXMLHTTPをCreateObjectしておいたオブジェクト変数です)。

デバッグ中にブレイクポイントを置いて中身を取り出してみると、こんな感じになっていました。

{"value":[{"element-6066-11e4-a52e-4f735466cecf":"b9135af5-43c6-41fe-97fe-5beac9e454e6"},{"element-6066-11e4-a52e-4f735466cecf":"1919ba58-b6c0-4a80-97ca-d67db5b78d24"},{"element-6066-11e4-a52e-4f735466cecf":"dda8dbd1-65a5-4b8f-9576-468c55d687e7"},{"element-6066-11e4-a52e-4f735466cecf":"72f33eb8-51cf-4608-baeb-9beac06831c1"},{"element-6066-11e4-a52e-4f735466cecf":"b5661379-5fbc-4156-a9cb-d8915aba3eff"},{"element-6066-11e4-a52e-4f735466cecf":"bd24209b-e46f-4aa8-9192-0ff9f4a1e7d8"},{"element-6066-11e4-a52e-4f735466cecf":"2b7d6e39-0139-461c-9cc7-3d563f70cb85"},{"element-6066-11e4-a52e-4f735466cecf":"d1f7995f-5197-4c04-abb2-4507282fac7f"}]}

見づらいと思うので整形したものがこちら↓です。

{"value":
[
{"element-6066-11e4-a52e-4f735466cecf":"b9135af5-43c6-41fe-97fe-5beac9e454e6"},
{"element-6066-11e4-a52e-4f735466cecf":"1919ba58-b6c0-4a80-97ca-d67db5b78d24"},
{"element-6066-11e4-a52e-4f735466cecf":"dda8dbd1-65a5-4b8f-9576-468c55d687e7"},
{"element-6066-11e4-a52e-4f735466cecf":"72f33eb8-51cf-4608-baeb-9beac06831c1"},
{"element-6066-11e4-a52e-4f735466cecf":"b5661379-5fbc-4156-a9cb-d8915aba3eff"},
{"element-6066-11e4-a52e-4f735466cecf":"bd24209b-e46f-4aa8-9192-0ff9f4a1e7d8"},
{"element-6066-11e4-a52e-4f735466cecf":"2b7d6e39-0139-461c-9cc7-3d563f70cb85"},
{"element-6066-11e4-a52e-4f735466cecf":"d1f7995f-5197-4c04-abb2-4507282fac7f"}
]
}

“value”というキーが一つに、複数のエレメントIDが返されました。

今回role=”tab”と言うのをキーワードに抽出しましたので、<li id=”tabTopicsX”・・・(Xには1~8の数字)で始まるタグの要素のエレメントIDが抽出されたもようです。

ちなみに、”element-6066-11e4-a52e-4f735466cecf”というのはエレメントIDを意味するキーIDでして、固定値です。「私は背が高い」と言う場合の「背」に当たる言葉だと思っていただければいいんですけど・・・・なんでこんな変な名称にしたんでしょうね・・・。扱いづらいったらありません。

重要なのはその次に書いてある”b9135af5-43c6-41fe-97fe-5beac9e454e6″とか”1919ba58-b6c0-4a80-97ca-d67db5b78d24″でして、これがtabtopicsの一つ一つのタブのエレメントIDです。

これが固定の値なのか動的に変わる値なのか私には分かりません。

動的に変わるものだという前提でいた方がよいでしょうね。その方が汎用性が高いですし。

この戻ってきた値をJsonConverterでVBAで扱える形にする(JsonConverter.basの中のParseJsonというFunctionを使います)と、次のようになります。

デバッグで戻ってきた値をJSONからVBAで扱える形にした直後の状態。oBufというのがそれです。

これを見るとoBufというDictionaryの中に「value」という値しか入っていないように見えますが、この「value」がキーとなっている値(ローカルウィンドウでは見えない)が実はコレクションになっているんです。

そこで値を取り出せるようにコレクション変数を用意します。こんな風にします。

    Set oBuf= JsonConverter.ParseJson(client.responseText)
    Dim elements As New Collection
    Set elements = oBuf("value")

念のためローカルウィンドウでelementsの中をのぞいてみましょう。

elementsの中身

elementsのItem1の中にさらにItem1があって、例の長い名前のキーが見えます。ということで、無事値をゲットできたようです。

エレメントのプロパティ

エレメントIDが分かったら、今度はエレメントのプロパティやAttributeの値を指定してとってくればよいです。

さてここで問題が。というか、言い訳が。

私は実はPropertyとAttributeの違いがよく分かっていません。

そこで、ここから先のコードには間違いがあると思いますし、もっとよい書き方があるかもしれません。

DOMのことをうすらぼんやりとしか分かっていない私が書いたコードですので、間違っていたらこっそり教えてください(The☆他力本願)。

Excel相談 https://kn-sharoushi.com/excel_consultation/ (←こちらの依頼フォームは匿名OKです)

エレメントIDを指定してPropertyとかAttributeをとってくるには次のように書きます。

client.Open "GET", "http://localhost:4444/session/" + sessionId + "/element/" + elements(ii)("element-6066-11e4-a52e-4f735466cecf") + "/text"

最後に「/text」とありますので、そのエレメントのテキストが取得できます。タグとタグに挟まれたテキスト部分のことです。

ロカールホストURL/sessionID/element/elementID/textでとってこれる値は上図のtextの部分

URLをとってくるには、上記の/textの部分を/property/hrefとすればOKです。

ここで一つ重要なことを言います。

GETでとってこれるのは値があるものだけです。

W3Cではいろいろなpropertyやattributeが用意されていますが、実際のWebページで使われてないものはとってこれません。

使っていない場合はそのpropertyやattributeはNullとなります。

Nullの場合はどうなるかというと、JsonConverterでエラーになるか、VBAの中でエラーになります。

例えば、次のようなタグにおいて、

<li id="tabTopics1" class="_3bryYR6xkbIHcdZdbybgnd ENXbYBReWSw0fU0fDUlIP" role="tab" aria-selected="true" aria-controls="tabpanelTopics1">
<a class="_1fWTm2E47ymhMM3suCaCGi _3aR1Wl7JOyOEug4F-C-ZyI cl-nofollow" data-cl-params="_cl_vmodule:tpto;_cl_link:tab;_cl_position:0;type:link" href="https://news.yahoo.co.jp/" data-cl_cl_index="1">ニュース</a></li>

hrefがあるのはaタグだけです。なのにliタグのエレメントIDを指定して/property/hrefとしても値をゲットできません。

当たり前のことなんですけど、私はこれで何回もエラーになりましたorz

気が付くまでえらい時間をロスしましたので、老婆心ながら。

ここまでのコード

ここまでのコードをまとめ、サブ化できるものはサブプロシージャにし、定数とすべきはConst宣言にして、さらにtabtopicsのタブの名称でシート名を作るようにしたコードが、下記です。

Sub YahooTopからカテゴリ別にシートを自動生成()
    'Webdriverの起動。Firefoxはデフォルトで4444番ポート
    Shell "C:\drivers\geckodriver.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")
    
    'ブラウザ起動(デバッグ時に確認しやすいよう、こまめに変数に拾っていく方針)
    Const cstLocalhost As String = "http://localhost:4444/session"
    Dim oBuf As Object
    Set oBuf = SendRequest(client, "POST", cstLocalhost, params)
    
    'ブラウザ起動処理の戻り値からSessionIdを取得
    Dim sessionId As String
    sessionId = oBuf("value")("sessionId")

    'URL遷移用のパラメータを定義
    Set params = New Dictionary
    Const cstYahooUrl As String = "https://www.yahoo.co.jp/"
    params.Add "url", cstYahooUrl

    '遷移
    SendRequest client, "POST", cstLocalhost & "/" + sessionId + "/url", params
    
    'タブトピックスを探すためのパラメータを準備
    Set params = New Dictionary
    params.Add "using", "css selector"
    params.Add "value", "[role=""tab""]"    'F12で観察したところタブトピックスはすべて"tab"をもっていた。
    
    'タブトピックスを探して`elementId`に控えておく
    Dim elementId As String
    Set oBuf = SendRequest(client, "POST", cstLocalhost & "/" + sessionId + "/elements", params)
    '↑elementでなくelementsであることに注意!複数の要素のIDが返される。
    
    Dim elements As Collection
    Set elements = New Collection
    Set elements = oBuf("value")
    
    Dim stText As String
    Dim lCnt As Long
    lCnt = elements.Count
    Const cstE As String = "element-6066-11e4-a52e-4f735466cecf"    'この名称がとても長いので可読性を上げるためにコンスト値とする。
    Dim ii As Long
    Dim sh As Worksheet
    For ii = 1 To lCnt
        stText = SendRequest(client, "GET", cstLocalhost & "/" + sessionId + "/element/" + elements(ii)(cstE) + "/text")("value")
        Set sh = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
        sh.Name = stText
    Next ii

    '終了処理(メモリ解放などの後始末)
    Set params = Nothing
    Set client = Nothing
    Set oBuf = Nothing
    Set sh = Nothing  
End Sub

Private Function SendRequest(ByRef client As Object, method As String, url As String, Optional data As Dictionary = Nothing) As Dictionary
    Dim stBuf As String
    'メソッドに応じてリクエスト送信
    client.Open method, url
    If method = "POST" Or method = "PUT" Then
        client.setRequestHeader "Content-Type", "application/json"
        stBuf = JsonConverter.ConvertToJson(data)
        client.Send stBuf
    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
    
    'メモリ解放
    Set Json = Nothing
End Function

これを実行するとこんな風にシートが追加されます。

やっとここまで・・・か(遠い目)。・・・・先は長いですね。

本日はここまで。

次回は、リンクを貼るため記事の値とURLをとってくる方法について紹介しようと思います。