【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

↓