VBA批量网抓快递详细信息数据到Excel
网址:暂不能发送（可以参考下图内，或者Q我： 284264152）批量提取以上网页内的快递信息到Excel表格中，有谁会的，帮帮忙了，最近在网上自家的苹果，急需跟踪所有订单，先谢谢了。
只提取最新的一条更新信息也是可以的，主要的是可以批量提取。
" Python实战课程，无需编程基础，轻松入门爬虫，带你学到如何从网上批量获得海量数据。"
……
去搜索 "爬网页" 吧
本帖最后由 雪舞子 于 2016-10-15 21:12 编辑
“窗体班”时写的“快递速查系统”，
下午稍修改一下还能用，只需在“A2”单元格输入单号，无需输入快递公司即可查询跟单，
楼主可仿此加个循环即可实现批量快递查询。
现在是苹果收货季节，祝楼主大丰收发大财！
Sub Test_XWZ()
Dim strText$, kd(1), i%, dh$, s, cxArr(1 To 100, 1 To 2)
Dim data As Object, context As Object, objJSON As Object
On Error GoTo 100
dh = Trim(Range("a2"))
Set Cms = CreateObject("msscriptcontrol.scriptcontrol")
With CreateObject("WinHttp.WinHttpRequest.5.1")
.Open "POST", "https://www.kuaidi100.com/autonumber/autoComNum?text=" & dh, False
.send
strText = .responsetext
With Cms
.Language = "JavaScript"
.AddCode "var mydata=" & strText
Set objJSON = .CodeObject
End With
For Each s In objJSON.mydata.auto
kd(i) = s.comCode
i = i + 1
Next
.Open "GET", "https://www.kuaidi100.com/query?type=" & kd(0) & "&postid=" & dh & "&id=1&valicode=&temp=0.12300412077456713", False
.send
strText = .responsetext
End With
With Cms
.Language = "JavaScript"
.AddCode "var mydata=" & strText
Set objJSON = .CodeObject
End With
i = 0
For Each s In objJSON.mydata.data
i = i + 1
cxArr(i, 2) = s.context
cxArr(i, 1) = s.ftime
Next
.Resize(i, 2) = cxArr
100: If Err.Number Then MsgBox "无查询记录"
End Sub
参考附件
**** Hidden Message *****
:'$ 雪舞子 发表于 2016-10-15 20:46
“窗体班”时写的“快递速查系统”，
下午稍修改一下还能用，只需在“A2”单元格输入单号，无需输入快递公 ...
谢谢老师分享资料
瀛︿範 不错，好好学习一下！
http://b225.photo.store.qq.com/psb?/V129ANsi1iV7R3/FsDZzGIxrytFmsvCZE.CRqS0CWhk6g6SmOqIMajQDhs!/b/dOEAAAAAAAAA&bo=owOLAqMDiwICCCw!
DAFDDFFD
^:D:lol:victory::handshake