Fetch Data from HTML Website using VBA - FREEMAPTOOLS.COM

问题

I am trying to input a post code into this website and pull the results into Excel using VBA

http://www.freemaptools.com/find-uk-postcodes-inside-radius.htm

In short you input a post code and set a radius either in miles or KM and it gives you all the post codes within that area. As you can imagine this tool would be very useful!

This is what I have so far:

Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = 0

url = "http://www.freemaptools.com/find-uk-postcodes-inside-radius.htm" 
ie.Navigate url


state = 0
Do Until state = 4
DoEvents
state = ie.readyState
Loop

It would be good if say cell A1 had the post code and cell A2 had the distance in KM. This script would then look at this as the variable.

I am not 100% sure put I think I then need to Parse the result to put them each into there own cell.

Any help with this would be incredible!

回答1:

Here you go

Download the file

 Sub postcode()

    Dim URL As String, str_output As String, arr_output() As String, row As Long
    Dim obj_Radius As Object, obj_Miles As Object, post_code As Object
    Dim btn As Object, btn_Radius As Object, tb_output As Object
    URL = "http://www.freemaptools.com/find-uk-postcodes-inside-radius.htm"

    Dim IE As Object
    Set IE = CreateObject("internetexplorer.application")

    IE.Visible = True
    IE.navigate URL

    Do While IE.readystate <> 4
        DoEvents
    Loop

    delay 5

    Set obj_Radius = IE.document.getelementbyid("tb_radius")
    obj_Radius.Value = ThisWorkbook.Sheets(1).Range("B1")


    Set obj_Miles = IE.document.getelementbyid("tb_radius_miles")
    obj_Miles.Value = ThisWorkbook.Sheets(1).Range("B2")

    Set post_code = IE.document.getelementbyid("goto")
    post_code.Value = ThisWorkbook.Sheets(1).Range("B3")

    Set btn_Radius = IE.document.getelementsbytagname("Input")
    For Each btn In btn_Radius
        If btn.Value = "Draw Radius" Then
            btn.Click
        End If
    Next

    Do While IE.readystate <> 4
        DoEvents
    Loop

    delay 10

    Set tb_output = IE.document.getelementbyid("tb_output")
    str_output = tb_output.innerText
    arr_output = Split(str_output, ",")

    row = 1
    For i = LBound(arr_output) To UBound(arr_output)
        ThisWorkbook.Sheets(1).Range("C" & row) = arr_output(i)
        row = row + 1
    Next

End Sub

Private Sub delay(seconds As Long)
    Dim endTime As Date
    endTime = DateAdd("s", seconds, Now())
    Do While Now() < endTime
        DoEvents
    Loop
End Sub

来源：https://stackoverflow.com/questions/21002146/fetch-data-from-html-website-using-vba-freemaptools-com