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

Question

我正在尝试将代码输入此网站，并使用VBA将结果导入Excel

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

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

这是我到目前为止所做的：

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具有KM中的距离则会很好。然后，此脚本将此视为变量。

我不是百分百肯定我认为我需要解析结果，将它们分别放入自己的单元格中。

任何帮助都会令人难以置信！

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