使用 VBA 从 HTML 网站获取数据 - FREEMAPTOOLS.COM

Question

我正在尝试在此网站中输入邮政编码并使用 VBA 将结果提取到 Excel 中

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

简而言之，您输入邮政编码并以英里或公里为单位设置半径，它会为您提供该区域内的所有邮政编码。你可以想象这个工具会非常有用！

这是我目前所拥有的：

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

如果说单元格 A1 有邮政编码，而单元格 A2 有距离以公里为单位，那就太好了。然后，此脚本会将其视为变量。

我不是 100% 确定我认为我需要解析结果以将它们各自放入自己的单元格中。

对此的任何帮助都将令人难以置信！

Answer 1

给你

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