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

我想input一个邮政编码到这个网站,并使用VBA将结果导入到Excel中

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

总之,你input一个邮政编码,并设置以英里或公里的半径,它给你在该地区的所有邮政编码。 正如你可以想象这个工具将是非常有用的!

这是我迄今为止:

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中的距离,那将是好的。 这个脚本会把这个看作variables。

我不是100%肯定,我认为我需要parsing的结果,把他们各自有自己的细胞。

任何帮助,这将是不可思议的!

干得好

下载文件

  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 

在这里输入图像说明