使用VBA从HTML网站获取数据-FREEMAPTOOLS.COM [英] Fetch Data from HTML Website using VBA - FREEMAPTOOLS.COM

问题描述

我正在尝试在该网站中输入邮政编码，然后使用VBA将结果拉入Excel

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

简而言之，您输入邮政编码并以英里或KM为单位设置半径，它将为您提供该区域内的所有邮政编码.如您所见，此工具将非常有用！

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

如果说单元格A1具有邮政编码，而单元格A2具有以KM为单位的距离，那将是很好的.然后，该脚本会将其视为变量.

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.

我不是100％肯定要放，我想然后需要解析结果以将它们每个放到自己的单元格中.

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!

推荐答案

去这里

> 下载文件

 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

这篇关于使用VBA从HTML网站获取数据-FREEMAPTOOLS.COM的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！