VBA+SeleniumBasicで検索順位チェッカー（改）
VBAでSeleniumBasicを使って検索順位チェッカーを作り、Google検索順位の履歴を管理します、
既に作成解説した、VBA+SeleniumBasicで検索順位チェッカー作成 こちらの改訂版になります。
Google検索をスクレイピングすることは、Google利用規約に反する可能性があります。
掲載したVBAコードの利用については、個々のご判断でお願いします。
SEO対策として各キーワードでの検索順位チェックは欠かせませんが、
複数のキーワードの検索順位を履歴で見やすく管理しできるようにしています。
・Chromeシークレットモード
・エレメントの取得方法
・順位変化をアイコンセット
Google順位変動が激しくなっているので、厳密に判定したいのでシークレットモードで起動
Google結果表示が時々で変化するので、より汎用的に変更
一目で分かり安いようにイコンセットで視覚化
シート構成
A4～：キーワード（個数制限なし）
B3：取得日時
B4～：検索結果に掲載されているページタイトル
C4～：検索結果に掲載されているページURL
D列：今回順位
E列以降：前日以前の順位履歴
検索順位チェッカーのVBA全コード
Option Explicit
Private Driver As Selenium.WebDriver
Private Const gUrl As String = "https://www.google.co.jp/"
'検索ボックスのCSS selector
Private Const gSearch As String = "#tsf > div:nth-child(2) > div > div.RNNXgb > div > div.a4bIc > input"
Sub RankCheker()
'起動シートの初期処理
Dim ws As Worksheet
Set ws = ActiveSheet
Dim siteUrl As String
siteUrl = ws.Range("C1") 'サイトURL
'Seleniumの初期処理
Dim sKey As New Selenium.Keys
Dim elm As Selenium.WebElement
Set Driver = New Selenium.WebDriver
Driver.AddArgument "--incognito" 'シークレットモード
Driver.Start "chrome"
Driver.window.Maximize
AppActivate Application.Caption
Dim i As Long, cntRank As Long
Dim myRng As Range
Dim sAdr1 As String, sAdr2 As String
With ws
'前回実行日が前日以前なら履歴を残す
If .Range("D3").Value < Date Then
Call setHeadFormat(ws)
Call setDetailFormat(ws)
End If
.Range("D3").Value = Now()
'出力範囲を初期クリア
.Range("A3").CurrentRegion.Offset(1, 1).Resize(, 3).ClearContents
For i = 4 To .Cells(.Rows.Count, 1).End(xlUp).Row
Driver.Get gUrl
AppActivate Application.Caption
Set elm = Driver.FindElementByCss(gSearch)
'検索ボックスへキーワード送信
elm.Clear
elm.SendKeys .Cells(i, 1)
elm.SendKeys sKey.Enter
'検索結果からサイト掲載要素を取得
Set elm = getElement(siteUrl, _
.Cells(i, 1).Value, _
cntRank)
If Not elm Is Nothing Then
.Cells(i, 2) = elm.FindElementByTag("h3").Text
.Cells(i, 3) = Mid(elm.Attribute("href"), Len(siteUrl) + 1)
.Cells(i, 4) = cntRank
Else
.Cells(i, 4) = "圏外"
End If
Next
End With
'終了処理：Close,Quitは無くても良いけど
Driver.Close
Driver.Quit
Set Driver = Nothing
MsgBox "取得完了"
End Sub
'指定selectorの要素を取得：ページ内に無い場合は「次へ」
Private Function getElement(ByVal siteUrl As String, _
ByVal sCss As String, _
ByRef cntRank As Long) _
As Selenium.WebElement
Set getElement = Nothing
Dim elm As Selenium.WebElement
Dim elms As Selenium.WebElements
Dim sHref As String
Dim cntPage As Long
cntRank = 0
On Error Resume Next
Do
'検索結果表示領域全体
Set elm = Driver.FindElementByCss("#rso")
If Err Then Exit Function
'明細は<div class="g">で繰り返されている
Set elms = elm.FindElementsByClass("g")
If Err Then Exit Function
If elms.Count = 0 Then Exit Function
For Each elm In elms
Set elm = elm.FindElementByClass("r").FindElementByTag("a")
If Err Then
Err.Clear
Else
If sHref <> elm.Attribute("href") Then
cntRank = cntRank + 1
If elm.Attribute("href") Like siteUrl & "*" Then
Set getElement = elm
Exit Function
End If
sHref = elm.Attribute("href")
End If
End If
Next
'１０ページまで
cntPage = cntPage + 1
If cntPage >= 10 Then
Exit Function
End If
Driver.FindElementByLinkText("次へ").Click
If Err Then
Exit Function
End If
Loop
End Function
'日付履歴追加
Private Sub setHeadFormat(ByVal ws As Worksheet)
Dim tgRng As Range, myRng As Range
Dim sAdr1 As String, sAdr2 As String
With ws
.Columns("D").Insert
.Columns("D").ColumnWidth = 4.6
.Range("D1").Clear
.Range("D1").NumberFormatLocal = "0"
.Range("D3").NumberFormatLocal = "m/d"
.Range("D3").HorizontalAlignment = xlCenter
.Range("D3").Value = Now()
End With
End Sub
'明細アイコンセットの設定
Private Sub setDetailFormat(ByVal ws As Worksheet)
Dim tgRng As Range, myRng As Range
Dim sAdr1 As String, sAdr2 As String
With ws
Set tgRng = .Range("A3").CurrentRegion
Set tgRng = Intersect(tgRng, tgRng.Offset(1, 3))
End With
tgRng.FormatConditions.Delete
For Each myRng In tgRng
sAdr1 = myRng.Address(True, True)
sAdr2 = myRng.Offset(, 1).Address(True, True)
With myRng.FormatConditions.AddIconSetCondition
.IconSet = ws.Parent.IconSets(xl3TrafficLights1)
.IconCriteria(1).Icon = xlIconGreenUpArrow
With .IconCriteria(2)
.Type = xlConditionValueFormula
.Value = "=" & sAdr2
.Operator = 7
.Icon = xlIconNoCellIcon
End With
With .IconCriteria(3)
.Type = xlConditionValueFormula
.Value = "=IF(" & sAdr2 & "=""""," & sAdr1 & "," & sAdr2 & ")"
.Operator = 5
.Icon = xlIconRedDownArrow
End With
End With
With myRng.FormatConditions.Add(Type:=xlExpression, Formula1:="=ISTEXT(" & myRng.Address(False, False) & ")")
.Interior.Color = vbYellow
End With
Next
End Sub
動作が安定しないときは、画面切り替わり直後に適宜待ち時間を入れてください。
Driver.Wait ミリ秒
Google検索のスクレイピングはGoogle利用規約に反する可能性もあり、
過度な検索実行は控えてください。
最後に
今後の課題としては、
エクセルなので、定時起動してのチェックができないのが一番の悩みです。
GAS(Google Apps Script)ならトリガーで簡単に実現できるので今後検討したいと思っています。
同じテーマ「マクロVBA技術解説」の記事
VBAでのSQLの基礎（SQL:Structured Query Language）
VBAで正規表現を利用する（RegExp）
VBAでメール送信する（CDO:Microsoft Collaboration Data Objects）
VBAでのOutlook自動操作
ADO(ActiveX Data Objects)の使い方の要点
特殊フォルダの取得（WScript.Shell,SpecialFolders）
参照設定、CreateObject、オブジェクト式の一覧
VBAのスクレイピングを簡単楽にしてくれるSelenium
VBA+SeleniumBasicで検索順位チェッカー作成
VBA+SeleniumBasicで検索順位チェッカー（改）
.Net FrameworkのSystem.Collectionsを利用
新着記事NEW ・・・新着記事一覧を見る
TRIMRANGE関数（セル範囲をトリム：端の空白セルを除外）｜エクセル入門(2024-08-30)
正規表現関数（REGEXTEST,REGEXREPLACE,REGEXEXTRACT）｜エクセル入門(2024-07-02)
エクセルが起動しない、Excelが立ち上がらない｜エクセル雑感(2024-04-11)
ブール型（Boolean）のis変数・フラグについて｜VBA技術解説(2024-04-05)
テキストの内容によって図形を削除する｜VBA技術解説(2024-04-02)
ExcelマクロVBA入門目次｜エクセルの神髄(2024-03-20)
VBA10大躓きポイント（初心者が躓きやすいポイント）｜VBA技術解説(2024-03-05)
テンキーのスクリーンキーボード作成｜ユーザーフォーム入門(2024-02-26)
無効な前方参照か、コンパイルされていない種類への参照です。｜エクセル雑感(2024-02-17)
初級脱出10問パック｜VBA練習問題(2024-01-24)
アクセスランキング ・・・ ランキング一覧を見る
1.最終行の取得（End,Rows.Count）｜VBA入門
2.セルのコピー&値の貼り付け（PasteSpecial）｜VBA入門
3.変数宣言のDimとデータ型｜VBA入門
4.繰り返し処理（For Next)｜VBA入門
5.RangeとCellsの使い方｜VBA入門
6.ブックを閉じる・保存（Close,Save,SaveAs）｜VBA入門
7.セルのクリア（Clear,ClearContents）｜VBA入門
8.メッセージボックス(MsgBox関数)｜VBA入門
9.条件分岐（Select Case）｜VBA入門
10.マクロとは？VBAとは？VBAでできること｜VBA入門
- ホーム
- マクロVBA応用編
- マクロVBA技術解説
- VBA+SeleniumBasicで検索順位チェッカー（改）
このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。
記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。
掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。