【ExcelVBA×Webスクレイピング】YahooMAPを使って住所から最寄り駅を3駅検索する

参照設定の方法がわからない方はこちら
https://qiita.com/daichi05w/items/73aa5c4022d76e7d6d09

'参照設定：Microsoft HTML Object Library
'参照設定：Microsoft Internet Controls

Public Const YAHOO_MAP_URL As String = "https://map.yahoo.co.jp/"
Public Const WAIT_TIME_VALUE As Long = 4000
Sub main()

    Dim objIE As InternetExplorer
    Dim docIE As HTMLDocument

    Dim result_func As Boolean

    Dim info_table() As String
    Dim exe_count As Long
    Dim i As Long

    exe_count = WorksheetFunction.CountA(Range("A:A")) - 1
    ReDim info_table(0 To exe_count − 1, 0 To 3)

    i = 0

    Do While i < exe_count

        info_table(i, 0) = space_buster(Cells(i + 2, 1).Value)

        i = i + 1

    Loop

    Set objIE = open_yahooMap()
    Set docIE = objIE.document

    i = 0

    Do While i < exe_count

        docIE.getElementsByClassName("SearchBoxKeyword__searchInputBox")(0).Focus
        docIE.getElementsByClassName("SearchBoxKeyword__searchInputBox")(0).innerText = info_table(i, 0)

        result_func = click_something(objIE, "button", "検索")
        Call sleep_millisecond(WAIT_TIME_VALUE)

        info_table(i, 1) = docIE.getElementsByClassName("Keyvalue__listItemRow")(0).innerText
        info_table(i, 2) = docIE.getElementsByClassName("Keyvalue__listItemRow")(1).innerText
        info_table(i, 3) = docIE.getElementsByClassName("Keyvalue__listItemRow")(2).innerText

        objIE.navigate YAHOO_MAP_URL
        Call sleep_millisecond(WAIT_TIME_VALUE)

        i = i + 1

    Loop

    objIE.Quit
    Set objIE = Nothing

    i = 0

    Do While i < exe_count

        Cells(i + 2, 2).Value = info_table(i, 1)
        Cells(i + 2, 3).Value = info_table(i, 2)
        Cells(i + 2, 4).Value = info_table(i, 3)

        i = i + 1

    Loop

End Sub
Sub waiting_update(ByVal objIE As InternetExplorer)

    Do While objIE.Busy = True Or objIE.readyState < READYSTATE_COMPLETE

        DoEvents

    Loop

End Sub
Sub sleep_millisecond(ByVal millisecond As Long)

    Application.Wait [Now()] + millisecond / 86400000

End Sub
Function click_something(ByVal objIE As InternetExplorer, ByVal tagName As String, ByVal keyword As String) As Boolean

    Dim objTag As Object

    For Each objTag In objIE.document.getElementsByTagName(tagName)

        If InStr(objTag.outerHTML, keyword) <> 0 Then

            objTag.Click
            click_something = True
            Call waiting_update(objIE)
            Exit Function

        End If

    Next

    click_something = False

End Function
Function open_yahooMap() As InternetExplorer

    Dim objIE As InternetExplorer

    Set objIE = New InternetExplorer

    objIE.Visible = True
    objIE.navigate YAHOO_MAP_URL
    Call sleep_millisecond(WAIT_TIME_VALUE)

    Set open_yahooMap = objIE
    Set objIE = Nothing

End Function
Function space_buster(ByVal buf As String) As String

    buf = Replace(buf, "　", "")
    buf = Replace(buf, " ", "")

    space_buster = buf

End Function

↓