第二回では1キーワードを検索してExcelシートにキーワード、検索順位、ページタイトルを入力するところまでできました。
今回やっていくのは以下の内容。ここまでできれば検索結果のスクレイピングとしては十分な機能かな。
- リンクURL、ディスクリプション
- 複数のキーワードを検索
- 2ページ目や3ページ目の結果も取得
前回までのおさらい
こちらが前回までで作ってきたプログラム。
まだ1キーワード、1ページの取得のみなので手でやっても良いレベルの情報量ですね。
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Sub web_scraping() Dim oIE As InternetExplorer 'oIEという変数はInternet Explorerが入ると宣言 Set oIE = New InternetExplorer 'oIEに新しいIEを起動して定義 oIE.Visible = True 'IEを表示させる Dim keyword As String keyword = "VBA" oIE.Navigate2 "https://www.google.com/search?q=" & keyword 'URLにアクセス Call browser_wait(oIE) 'search_result に検索結果部分をページごとにリストとして格納 Dim search_result_list Set search_result_list = oIE.Document.querySelectorAll(".srg .rc") 'データシートの入力開始行番号を取得 Dim writing_start_row As Long writing_start_row = Sheets("データ").UsedRange.Row + 1 'search_result の個数分繰り返し処理 Dim i As Integer For i = 0 To search_result_list.Length - 1 '検索結果一つひとつを順番に参照してデータシートに格納 With Sheets("データ") .Range("A" & i + writing_start_row) = keyword 'キーワード .Range("B" & i + writing_start_row) = i + 1 '検索順位 .Range("C" & i + writing_start_row) = search_result_list.Item(i).querySelector("h3").innerText 'タイトル End With Next Sleep 3000 '3秒待機 oIE.Quit 'IEを閉じる End Sub Sub browser_wait(oIE) '読み込みが完了するまで待つ While oIE.ReadyState <> READYSTATE_COMPLETE Or oIE.Busy = True DoEvents Sleep 100 Wend '読み込み完了後の安定化待ち Sleep 200 End Sub
URLとディスクリプションも取得する
まずはExcelのデータシートにURLとディスクリプションの項目を追加。
URLの取得対象要素を探す
Chromeの要素の検証(F12)で対象となる要素を探す。
URL取得のコードを追記
コードはタイトルの取得部分の応用でOK。レンジをD列に変更、selectorをa
に変更、取得するプロパティをhref
に変更することで「i
番目の検索結果配下のaタグのhref(URL)をD列最終行の次の行に入力」となる。
'検索結果一つひとつを順番に参照してデータシートに格納 With Sheets("データ") .Range("A" & i + writing_start_row) = keyword 'キーワード .Range("B" & i + writing_start_row) = i + 1 '検索順位 .Range("C" & i + writing_start_row) = search_result_list.Item(i).querySelector("h3").innerText 'タイトル .Range("D" & i + writing_start_row) = search_result_list.Item(i).querySelector("a").href 'URL End With
ディスクリプション取得要素を探す
ディスクリプション取得のコードを追記
タイトル、URLと違いタグ名ではなくクラス名の指定なので .st
先頭にドットがが必要な点に注意。
'検索結果一つひとつを順番に参照してデータシートに格納 With Sheets("データ") .Range("A" & i + writing_start_row) = keyword 'キーワード .Range("B" & i + writing_start_row) = i + 1 '検索順位 .Range("C" & i + writing_start_row) = search_result_list.Item(i).querySelector("h3").innerText 'タイトル .Range("D" & i + writing_start_row) = search_result_list.Item(i).querySelector("a").href 'URL .Range("E" & i + writing_start_row) = search_result_list.Item(i).querySelector(".st").innerText 'ディスクリプション End With
ここまでで一旦実行してみましょう。
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Sub web_scraping() Dim oIE As InternetExplorer 'oIEという変数はInternet Explorerが入ると宣言 Set oIE = New InternetExplorer 'oIEに新しいIEを起動して定義 oIE.Visible = True 'IEを表示させる Dim keyword As String keyword = "VBA" oIE.Navigate2 "https://www.google.com/search?q=" & keyword 'URLにアクセス Call browser_wait(oIE) 'search_result に検索結果部分をページごとにリストとして格納 Dim search_result_list Set search_result_list = oIE.Document.querySelectorAll(".srg .rc") 'データシートの入力開始行番号を取得 Dim writing_start_row As Long writing_start_row = Sheets("データ").UsedRange.Rows.Count + 1 'search_result の個数分繰り返し処理 Dim i As Integer For i = 0 To search_result_list.Length - 1 '検索結果一つひとつを順番に参照してデータシートに格納 With Sheets("データ") .Range("A" & i + writing_start_row) = keyword 'キーワード .Range("B" & i + writing_start_row) = i + 1 '検索順位 .Range("C" & i + writing_start_row) = search_result_list.Item(i).querySelector("h3").innerText 'タイトル .Range("D" & i + writing_start_row) = search_result_list.Item(i).querySelector("a").href 'URL .Range("E" & i + writing_start_row) = search_result_list.Item(i).querySelector(".st").innerText 'ディスクリプション End With Next Sleep 3000 '3秒待機 oIE.Quit 'IEを閉じる End Sub Sub browser_wait(oIE) '読み込みが完了するまで待つ While oIE.ReadyState <> READYSTATE_COMPLETE Or oIE.Busy = True DoEvents Sleep 100 Wend '読み込み完了後の安定化待ち Sleep 200 End Sub
複数のキーワードを検索
シート「キーワード」に検索したいキーワードを入力。
ここで複数キーワードを検索する場合のプログラムの流れを再確認
- キーワードの数だけ2以降を繰り返し
- キーワードを検索
- 検索結果からデータを取得
- 検索結果の数だけ5を繰り返し
- 検索結果から1つずつデータを取り出してシートに入力
「繰り返し」という言葉が2回でてきました。つまりFor~Next文が2つになるということ。
ForのなかにForを入れて・・・ということもできるのですが、今回の場合異なる機能をネスト(入れ子に)することになるので可読性を維持するためにも別のプロシージャに分けてから呼び出す形を取りたいと思います。
ネストでも良いけどちょっと読みづらい
' ※例としてデフォルメして書いています For i = 0 to キーワードリスト.length oIE.キーワード(i)で検索 For ii 0 to oIE.検索結果リスト.length Range("B" & i + 記入開始行番号) = 検索結果リスト.Item(i) Next ii Next i
プロシージャを分けることで機能ごとにシンプルに
今回のスクレイピングツールは大きくこの2つの機能に分けられます。
- 複数キーワードを連続で検索
- 検索結果からデータを取得してシートに入力
' ※例としてデフォルメして書いています Sub メイン() For i = 0 to キーワードリスト.length キーワード(i)で検索 Call データ取得(oIE) Next i End Sub Sub データ取得(oIE) For i 0 to oIE.検索結果リスト.length Range("B" & i + 記入開始行番号) = 検索結果リスト.Item(i) Next i End Sub
このように分割しておくことでメンテナンス性も向上します。
キーワードを順番に検索していくプログラム
まずはキーワードを検索(検索結果URLへアクセス)する部分を書いていきます。
Dim i As Integer For i = 2 To Sheets("キーワード").UsedRange.Rows.Count keyword = Sheets("キーワード").Range("A" & i) oIE.Navigate2 "https://www.google.com/search?q=" & keyword 'URLにアクセス Call browser_wait(oIE) Sleep 3000 '3秒待機 Next
こんな感じでしょうか。
2行目から開始したいのでi = 2 to
、そしてキーワードシートの最終行まで繰り返すのでSheets("キーワード").UsedRange.Rows.Count
を終了の数値とします。
また、あまり短時間に連続アクセスするとサーバに負荷がかかって宜しく無いので、1キーワード検索を終えるごとに3秒の待機時間を入れています。
さぁ実行。
怒られました。これは同じプロシージャ内でDim i As Integer
を2回宣言しとるやんけ のエラーです。
'search_result の個数分繰り返し処理 'Dim i As Integer For i = 0 To search_result_list.Length - 1 '検索結果一つひとつを順番に参照してデータシートに格納 With Sheets("データ") .Range("A" & i + writing_start_row) = keyword 'キーワード .Range("B" & i + writing_start_row) = i + 1 '検索順位 .Range("C" & i + writing_start_row) = search_result_list.Item(i).querySelector("h3").innerText 'タイトル .Range("D" & i + writing_start_row) = search_result_list.Item(i).querySelector("a").href 'URL .Range("E" & i + writing_start_row) = search_result_list.Item(i).querySelector(".st").innerText 'ディスクリプション End With Next
こっちのFor文はあとで別プロシージャに分けるので一旦宣言をコメントアウトしておきます。
ここまでのコード全文
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Sub web_scraping() Dim oIE As InternetExplorer 'oIEという変数はInternet Explorerが入ると宣言 Set oIE = New InternetExplorer 'oIEに新しいIEを起動して定義 oIE.Visible = True 'IEを表示させる Dim keyword As String Dim i As Integer For i = 2 To Sheets("キーワード").UsedRange.Rows.Count keyword = Sheets("キーワード").Range("A" & i) oIE.Navigate2 "https://www.google.com/search?q=" & keyword 'URLにアクセス Call browser_wait(oIE) Sleep 3000 '3秒待機 Next 'search_result に検索結果部分をページごとにリストとして格納 Dim search_result_list Set search_result_list = oIE.Document.querySelectorAll(".srg .rc") 'データシートの入力開始行番号を取得 Dim writing_start_row As Long writing_start_row = Sheets("データ").UsedRange.Rows.Count + 1 'search_result の個数分繰り返し処理 'Dim i As Integer For i = 0 To search_result_list.Length - 1 '検索結果一つひとつを順番に参照してデータシートに格納 With Sheets("データ") .Range("A" & i + writing_start_row) = keyword 'キーワード .Range("B" & i + writing_start_row) = i + 1 '検索順位 .Range("C" & i + writing_start_row) = search_result_list.Item(i).querySelector("h3").innerText 'タイトル .Range("D" & i + writing_start_row) = search_result_list.Item(i).querySelector("a").href 'URL .Range("E" & i + writing_start_row) = search_result_list.Item(i).querySelector(".st").innerText 'ディスクリプション End With Next Sleep 3000 '3秒待機 oIE.Quit 'IEを閉じる End Sub Sub browser_wait(oIE) '読み込みが完了するまで待つ While oIE.ReadyState <> READYSTATE_COMPLETE Or oIE.Busy = True DoEvents Sleep 100 Wend '読み込み完了後の安定化待ち Sleep 200 End Sub
気を取り直してもう一度。
【ExcelVBAでスクレイピング入門】Googleで検索順位を自動取得してみる③ ~複数キーワードの検索とデータ取得~
無事に最後のキーワードまで検索されました。
しかし、取得できている検索結果は「雑記」のみ。それもそのはずこのプログラムの流れではすべてのキーワードを検索したあとに検索結果を取得するということになっています。
これをキーワードを検索→データ取得→次のキーワードを検索 に書き換えていきます。
検索機能とデータ取得機能を切り分ける
可読性・メンテナンス性維持のためにweb_scraping
プロシージャの中からデータ取得機能をdata_input
プロシージャとして切り取って作ります。
Sub data_input()
もSub browser_wait(oIE)
と同じようにIEオブジェクトを受け取る必要があります。→Sub data_input(oIE)
変数keyword
も範囲外なので引数に持たせる→Sub data_input(oIE, keyword)
'Dim i As Integer
のコメントアウトを忘れずに解除しておきます→Dim i As Integer
(グローバル変数にしてもいいかなぁとふと思ったけど今回はこのままいきます。
検索キーワードのFor文内でdata_inputを呼び出す
oIE.Navigate2 "https://www.google.com/search?q=" & keyword 'URLにアクセス Call browser_wait(oIE) Call data_input(oIE, keyword)
Call browser_wait(oIE)
の直後(検索結果ページ読み込み完了したあと)にCall data_input(oIE keyword)
と記述。
ここまでのコード全文
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Sub web_scraping() Dim oIE As InternetExplorer 'oIEという変数はInternet Explorerが入ると宣言 Set oIE = New InternetExplorer 'oIEに新しいIEを起動して定義 oIE.Visible = True 'IEを表示させる Dim keyword As String Dim i As Integer For i = 2 To Sheets("キーワード").UsedRange.Rows.Count keyword = Sheets("キーワード").Range("A" & i) oIE.Navigate2 "https://www.google.com/search?q=" & keyword 'URLにアクセス Call browser_wait(oIE) Call data_input(oIE, keyword) Sleep 3000 '3秒待機 Next Sleep 3000 '3秒待機 oIE.Quit 'IEを閉じる End Sub Sub data_input(oIE, keyword) 'search_result に検索結果部分をページごとにリストとして格納 Dim search_result_list Set search_result_list = oIE.Document.querySelectorAll(".srg .rc") 'データシートの入力開始行番号を取得 Dim writing_start_row As Long writing_start_row = Sheets("データ").UsedRange.Rows.Count + 1 'search_result の個数分繰り返し処理 Dim i As Integer For i = 0 To search_result_list.Length - 1 '検索結果一つひとつを順番に参照してデータシートに格納 With Sheets("データ") .Range("A" & i + writing_start_row) = keyword 'キーワード .Range("B" & i + writing_start_row) = i + 1 '検索順位 .Range("C" & i + writing_start_row) = search_result_list.Item(i).querySelector("h3").innerText 'タイトル .Range("D" & i + writing_start_row) = search_result_list.Item(i).querySelector("a").href 'URL .Range("E" & i + writing_start_row) = search_result_list.Item(i).querySelector(".st").innerText 'ディスクリプション End With Next End Sub Sub browser_wait(oIE) '読み込みが完了するまで待つ While oIE.ReadyState <> READYSTATE_COMPLETE Or oIE.Busy = True DoEvents Sleep 100 Wend '読み込み完了後の安定化待ち Sleep 200 End Sub
実行してみましょう!
いい感じですね。
まとめ
- 複数キーワードを連続検索できた
- ページを移動しながらデータ取得できた
- 可読性・メンテナンス性維持のためにも機能ごとにプロシージャを分けることをおすすめします
ちなみに機能単位での切り分けは厳密に言うとデータの取得(パース)部分とシート記入部分にも分けられますね。まぁ今回の規模なら一つで良いかと思いますが、取得項目が大量の場合はもっと別のやり方(配列や辞書に格納してから一括貼り付け)が良いかもしれません。
さて、ここまでで満足した人もいるかもしれませんが、次回第四回は今回できなかったページャーをたどる機能を追加していきます。
検索結果一番下にある「次へ」を押していく機能です。これが実装できれば1キーワード100位までとか取得できるようになりますね。
お楽しみに~