【SeleniumBasic】Google検索してURLをシートに書き出す【ExcelVBA】

Set elements = driver.FindElementsByCss(".yuRUbf a")
:
(中略)
:
(ループの中で)
sh.Cells(lRow, ii).Value = elements(ii).Attribute("href")

    '検索結果を取得
    Dim elements As Selenium.WebElements
    Set elements = driver.FindElementsByCss(".yuRUbf")
    driver.Wait clWAIT
    
    Dim stResults() As Variant  '検索結果を格納する多次元配列。

    '検索結果を配列にいったん格納
    Dim Cnt As Long
    Cnt = elements.Count
    
    ReDim stResults(1 To 2, 1 To Cnt)
    
    Dim ii As Long
    For ii = 1 To Cnt
        stResults(1, ii) = elements(ii).FindElementByTag("h3").Text             '検索結果文字列
        stResults(2, ii) = elements(ii).FindElementByTag("a").Attribute("href") '飛び先サイトのURL
    Next ii

Option Explicit
'ワークシート制御用Enum
Enum e
    検索結果 = 1
    飛び先のサイトURL
    TheEnd = 飛び先のサイトURL
End Enum

'
'作成：野口香
'作成：2023/12/22
'
'Google検索の「設定」で「連続スクロール」をオン(規定値)にしてある前提で作ってあります。
'
Public Sub Google検索()
    '作業用シート
    Dim sh As Worksheet
    Set sh = ThisWorkbook.Worksheets(1)
    
    'Seleniumを用意
    Dim driver As Object
    Set driver = CreateObject("Selenium.WebDriver")
    
    'スクレイピングのお作法・・・wait時間
    Const clWAIT As Long = 100
    
    'Chromeをスタート
    driver.Start "Chrome"
    
    'ブラウザを最大サイズに
    driver.Window.Maximize
    
    '検索文字をワークシートから取得
    Dim stMoji As String
    stMoji = sh.Range("B1").Value
    
    '検索結果の何件目以降か把握
    Dim lOver As Long
    lOver = sh.Range("I1").Value
    If lOver > 0 Then
        lOver = lOver - 1   'Google検索の仕様(0起算)に合わせるため、１をマイナスしておく。
    End If
        
    'GoogleURLを生成する
    Dim stUrl As String
    stUrl = "https://www.google.com/search?q=" & stMoji & "&start=" & lOver & "&num=100"
    sh.Range("B2").Value = stUrl    '参考程度にワークシート上に検索に使うURL文字列を転記
    
    'ワークシートの前回検索結果をクリアコンテンツ
    Dim lLast1 As Long
    lLast1 = sh.Cells(sh.Rows.Count, e.検索結果).End(xlUp).Row
    Dim lLast2 As Long
    lLast2 = sh.Cells(sh.Rows.Count, e.飛び先のサイトURL).End(xlUp).Row
    If lLast1 > lLast2 Then
        'Nothing
    Else
        '大きい方を採用
        lLast1 = lLast2
    End If
    
    Const clStart As Long = 4   'データ行の始まり
    
    If lLast1 <= clStart Then
        '前回データがないのでなにもしない
    Else
        '前回データをクリアコンテンツ
        sh.Range(sh.Cells(clStart, e.検索結果), sh.Cells(lLast1, e.TheEnd)).ClearContents
    End If
    
    
    '検索
    driver.Get stUrl
    driver.Wait clWAIT
    
    '検索結果を取得
    Dim elements As Selenium.WebElements
    Set elements = driver.FindElementsByCss(".yuRUbf")
    driver.Wait clWAIT
    
    Dim stResults() As Variant  '検索結果を格納する多次元配列。

    '検索結果を配列にいったん格納
    Dim Cnt As Long
    Cnt = elements.Count
    
    ReDim stResults(1 To 2, 1 To Cnt)
    
    Dim ii As Long
    For ii = 1 To Cnt
        stResults(1, ii) = elements(ii).FindElementByTag("h3").Text             '検索結果文字列
        stResults(2, ii) = elements(ii).FindElementByTag("a").Attribute("href") '飛び先サイトのURL
    Next ii
    
    Dim lNext As Long
    lNext = Cnt   '既に調べてある件数を把握する
    Dim myBy As Selenium.By
    Set myBy = New Selenium.By
    If driver.IsElementPresent(myBy.Css("#botstuff > div > div.sdjuGf > div.WZH4jc.w7LJsc > a.T7sFge.sW9g3e.VknLRd")) Then
    
        '「もっと見る」のstyleがtransform: scale(1);なら可視、transform: scale(0);なら不可視。
        'IsDisplayedやIsEnabledは常にtrueで変化がなかったので使えず、このstyleの変化を拾うことにした。
        
        Do While driver.FindElementByCss("#botstuff > div > div.sdjuGf > div.WZH4jc.w7LJsc > a.T7sFge.sW9g3e.VknLRd").Attribute("style") = "transform: scale(1);"
            
            driver.Wait clWAIT
            '「もっと見る」があるならめいいっぱいスクロールダウンしておく
            driver.ExecuteScript ("window.scrollTo(0, document.documentElement.scrollHeight);")
            driver.Wait clWAIT
            
            '検索結果を取得
            Set elements = driver.FindElementsByCss(".yuRUbf")
            driver.Wait clWAIT
            
            '検索結果を配列にいったん格納
            Cnt = elements.Count
            If Cnt = lNext Then
                'もう新しい検索結果はない
            Else
                ReDim Preserve stResults(1 To 2, 1 To Cnt)
                For ii = lNext To Cnt
                    stResults(1, ii) = elements(ii).FindElementByTag("h3").Text
                    stResults(2, ii) = elements(ii).FindElementByTag("a").Attribute("href")
                Next ii
                
            End If
            
            lNext = Cnt
        Loop
    End If
    
    '検索結果を取得
    Set elements = driver.FindElementsByCss(".yuRUbf")
    driver.Wait clWAIT
    Cnt = elements.Count
    If lNext < Cnt Then
        '最後の検索結果が残っているので、それらも取得する
        
        '検索結果を配列にいったん格納
        ReDim Preserve stResults(1 To 2, 1 To Cnt)
        For ii = lNext To Cnt
            stResults(1, ii) = elements(ii).FindElementByTag("h3").Text
            stResults(2, ii) = elements(ii).FindElementByTag("a").Attribute("href")
        Next ii
    End If

    '配列の内容をExcelに書き出す
    sh.Range(sh.Cells(clStart, e.検索結果), sh.Cells(clStart + UBound(stResults, 2) - 1, e.TheEnd)).Value = WorksheetFunction.Transpose(stResults)
    
    '終了
    driver.Close
    
    'オブジェクト解放
    Set sh = Nothing
    Set driver = Nothing
    Set myBy = Nothing
    
    '終了メッセージ
    MsgBox "終了"
End Sub