自动获取网页数据

TomingTang · 发表于 2015-1-26 14:36

问题描述：

大家好，我想找一个网页抓取网页数据的程序，论坛上有对应的，不过总是改不对。我懂得基本的vba，不过对网页数据获取就不懂了。

需要获取数据的网页共有500多页，不能一个个复制，只能通过vba批量获取。获取结果如附件左边表。谢谢。

网页抓取数据.zip (9.13 KB, 下载次数: 116)

网页地址：http://usa.postcodebase.com/zh-hans/all

浮华、缠绕指尖 · 发表于 2015-1-26 17:17

本帖最后由浮华、缠绕指尖于 2015-1-26 23:21 编辑

try it if help you

Sub test()
Dim p, i, j, html, tb, m
Set html = CreateObject("htmlfile")
With CreateObject("winhttp.winhttprequest.5.1")
For p = 0 To 502
DoEvents
.Open "GET", "http://usa.postcodebase.com/zh-hans/all?page=" & p, False
.send
html.body.innerhtml = .responsetext
Set tb = html.getElementsByTagName("tr")
For i = IIf(p = 0, 0, 1) To tb.Length - 1
m = m + 1
For j = 0 To tb(i).Cells.Length - 1
Cells(m, j + 1) = tb(i).Cells(j).innerText
Next
Next
Next
End With
End Sub

复制代码

liucqa · 发表于 2015-1-26 20:02

先用fiddler抓包，然后才能写代码，自己看一下论坛教程

zss427607 · 发表于 2015-1-26 21:31

看看吴姐的不懂也来抓网页，互相交流一下。

fkeih_007 · 发表于 2015-1-26 21:46

以下这个代码实验可行，就是500多页获取要花点时间，我也是刚学，欢迎讨论。

Sub getzip()
On Error Resume Next
[a1].CurrentRegion.Offset(1).Clear
With CreateObject("Microsoft.XMLHTTP")
For P = 0 To 502
.Open "GET", "http://usa.postcodebase.com/zh-hans/all?page=" & P, False
.send
Do Until .ReadyState = 4
DoEvents
Loop
tt = .responseText
n = Range("a65536").End(xlUp).Row
temp = Split(Split(.responseText, "odd views-row-first")(1), "views-field views-field-field-zip")
For i = 1 To 100
Cells(n + i, 1) = Split(Split(temp(i), "node/")(1), """>")(0)
Cells(n + i, 2) = Split(Split(temp(i), """>")(1), "<")(0)
Cells(n + i, 3) = Split(Split(temp(i), """>")(2), "<")(0)
Next i
Range("A65536").End(xlUp).Select
Next P
End With
End Sub

复制代码

fkeih_007 · 发表于 2015-1-26 21:46

Sub getzip()
On Error Resume Next
[a1].CurrentRegion.Offset(1).Clear
With CreateObject("Microsoft.XMLHTTP")
For P = 0 To 502
.Open "GET", "http://usa.postcodebase.com/zh-hans/all?page=" & P, False
.send
Do Until .ReadyState = 4
DoEvents
Loop
tt = .responseText
n = Range("a65536").End(xlUp).Row
temp = Split(Split(.responseText, "odd views-row-first")(1), "views-field views-field-field-zip")
For i = 1 To 100
Cells(n + i, 1) = Split(Split(temp(i), "node/")(1), """>")(0)
Cells(n + i, 2) = Split(Split(temp(i), """>")(1), "<")(0)
Cells(n + i, 3) = Split(Split(temp(i), """>")(2), "<")(0)
Next i
Range("A65536").End(xlUp).Select
Next P
End With
End Sub

复制代码

fkeih_007 · 发表于 2015-1-26 21:49

Sub getzip()
   On Error Resume Next
[a1].CurrentRegion.Offset(1).Clear
   With CreateObject("Microsoft.XMLHTTP")
      For P = 0 To 502
         .Open "GET", "http://usa.postcodebase.com/zh-hans/all?page=" & P, False
         .send
         Do Until .ReadyState = 4
               DoEvents
         Loop
         tt = .responseText
         n = Range("a65536").End(xlUp).Row
         temp = Split(Split(.responseText, "odd views-row-first")(1), "views-field views-field-field-zip")
         For i = 1 To 100
            Cells(n + i, 1) = Split(Split(temp(i), "node/")(1), """>")(0)
            Cells(n + i, 2) = Split(Split(temp(i), """>")(1), "<")(0)
            Cells(n + i, 3) = Split(Split(temp(i), """>")(2), "<")(0)
         Next i
         Range("A65536").End(xlUp).Select
      Next P
   End With
End Sub

fkeih_007 · 发表于 2015-1-26 21:57

怎么发带代码的贴子要审核，发不上

fkeih_007 · 发表于 2015-1-26 22:13

5楼已经给出代码，但是500多页的数据确实很多，加上网站也比较慢，会出现假死状态，我也是刚学，欢迎讨论

suwenkai · 发表于 2015-1-26 22:23

做了前面6页，参考一下

Sub 按钮1_单击()
Dim url, html
Set html = CreateObject("htmlfile")
With CreateObject("msxml2.xmlhttp")
For a = 0 To 5
If a = 0 Then
b = 0
url = "http://usa.postcodebase.com/zh-hans/all"
Else
b = 1
url = "http://usa.postcodebase.com/zh-hans/all?page=" & a
End If
.Open "get", url, False
.send
s = .responsetext
html.body.innerhtml = s
Set tb = html.all.tags("table")(0).Rows
For i = b To tb.Length - 1
n = n + 1
For j = 0 To tb(i).childnodes.Length - 1
Cells(n, j + 1) = tb(i).childnodes(j).innertext
Next
Next
Next
End With
End Sub

复制代码

		自动登录	找回密码
密码			免费注册

[求助] 自动获取网页数据

评分

评分

评分

最新热点 /1