【ExcelVBA】Yahoo!地図からルート検索【SeleniumBasic】

Option Explicit
'ワークシートに表示する情報のヘッダ
Enum e
    出発地 = 1
    目的地
    往路距離1
    往路距離2
    往路距離3
    復路距離1
    復路距離2
    復路距離3
    TheEnd = 復路距離3
End Enum
'
'作成：野口香
'作成：2023/06/14
'
Public Sub GetMap()
    '作業用シート
    Dim sh As Worksheet
    Set sh = ThisWorkbook.Worksheets(1)
    
    'Seleniumを用意
    Dim driver As Object
    Set driver = CreateObject("Selenium.WebDriver")
    
    'スクレイピングのお作法・・・wait時間
    Const clWAIT As Long = 500
    
    'Chromeをスタート
    driver.Start "Chrome"
    
    'ブラウザを最大サイズに
    driver.Window.Maximize
    
    '前回までの情報をクリアしておく
    Const clHeader As Long = 6
    sh.Range(sh.Cells(clHeader + 1, e.往路距離1), sh.Cells(sh.Rows.Count, e.TheEnd)).ClearContents
    
    'Yahoo!地図のURL
    Const cstUrl As String = "https://map.yahoo.co.jp/route/car"
    driver.Get cstUrl
    driver.Wait clWAIT * 15 'けっこう長めに待たないとだめみたいだ・・・①
    
    'Loop開始前、準備
    'ワークシート上の調査対象件数が何件か把握しておく
    Dim ii As Long, lRow As Long
    Const cstStart As Long = clHeader + 1 'データが入っている行の最初の行の行番号
    
    lRow = sh.Cells(cstStart, e.目的地).End(xlDown).Row
    If lRow = sh.Rows.Count Then
        lRow = cstStart
    End If
    
    '出発地
    Dim el As Object
    Dim myBy As By
    Set myBy = New By
    Dim Keys As Keys
    Set Keys = New Keys
    
    For ii = cstStart To lRow
    
        '「スタート地点の入力を削除」ボタンが存在するなら・・・②
        If driver.IsElementPresent(myBy.XPath("//*[@id=""search_route_page""]/div[1]/div[1]/div/div[1]/div[1]/div/button")) Then
            '「スタート地点の入力を削除」ボタンを押す(これをやっておかないとInputボックスの中身がクリアされなかった)　・・・②
            driver.FindElementByXPath("//*[@id=""search_route_page""]/div[1]/div[1]/div/div[1]/div[1]/div/button").Click
            driver.Wait clWAIT
        End If
        
        '出発地
        Set el = driver.FindElementByXPath("//*[@id=""route_start""]")
        el.Clear
        driver.Wait clWAIT
        
        el.SendKeys sh.Cells(ii, e.出発地).Value
        driver.Wait clWAIT
        
        el.SendKeys Keys.Tab    'ここでタブキーを押すのは、これをやっておかないと出発地点の候補がリスト表示されてしまい、次の目的地のエレメントに覆いかぶさってしまい、
        '「そんなエレメントは見つからない」というエラーになってしまうため。・・・③
        driver.Wait clWAIT
        
        '「ゴール地点の入力を削除」ボタンを押す(これをやっておかないとInputボックスの中身がクリアされなかった)
        If driver.IsElementPresent(myBy.XPath("//*[@id=""search_route_page""]/div[1]/div[1]/div/div[1]/div[2]/div/button")) Then
            driver.FindElementByXPath("//*[@id=""search_route_page""]/div[1]/div[1]/div/div[1]/div[2]/div/button").Click
            driver.Wait clWAIT
        End If
        
        '目的地
        Set el = driver.FindElementByXPath("//*[@id=""route_goal""]")
        el.Clear
        driver.Wait clWAIT
        
        el.SendKeys sh.Cells(ii, e.目的地).Value
        driver.Wait clWAIT
        
        '「ルートを検索」ボタンをクリック
        driver.FindElementByXPath("//*[@id=""search_route_page""]/div/div[2]/button").Click
        driver.Wait clWAIT * 10 '少し長めに待つ
        
        '往路の距離を取得する
        Call GetKM("往路", sh, ii, driver, clWAIT)
        
        '「スタートとゴールを入れ替え」ボタンを押す
        driver.FindElementByXPath("//*[@id=""search_route_page""]/div[1]/div[1]/div/div[2]/div/button").Click
        driver.Wait clWAIT * 10 '少し長めに待つ
        
        '復路の距離を取得する
        Call GetKM("復路", sh, ii, driver, clWAIT)
        
    Next ii
    '終了
    driver.Close
    
    'オブジェクト解放
    Set sh = Nothing
    Set driver = Nothing
    Set el = Nothing
    
    '終了メッセージ
    MsgBox "終了"
    
End Sub

Private Sub GetKM(ByVal st路, ByRef sh As Worksheet, ByRef ii As Long, ByRef driver As Object, ByRef clWAIT As Long)
    Dim lColumn As Long
    
    If st路 = "往路" Then
        lColumn = e.往路距離1
    Else
        lColumn = e.復路距離1
    End If
    
    '距離1を取得
    sh.Cells(ii, lColumn).Value = Replace(driver.FindElementByXPath("//*[@id=""search_route_page""]/div[2]/ul/li[1]/button/div/div[1]/span").Text, "-", "")
    driver.Wait clWAIT
    
    '距離2を取得
    sh.Cells(ii, lColumn + 1).Value = Replace(driver.FindElementByXPath("//*[@id=""search_route_page""]/div[2]/ul/li[2]/button/div/div[1]/span").Text, "-", "")
    driver.Wait clWAIT
    
    '距離3を取得
    sh.Cells(ii, lColumn + 2).Value = Replace(driver.FindElementByXPath("//*[@id=""search_route_page""]/div[2]/ul/li[3]/button/div/div[1]/span").Text, "-", "")
    driver.Wait clWAIT

End Sub