网页抓取分享

onlycxb

网抓分享：乐彩网
抓取排行榜及相关地址

1. Sub 乐彩网()
   
2.     Dim Url As String, Xml As Object, Html As Object, tb, lib
   
3.     Dim i, j
   
4.     Set Html = CreateObject("htmlfile")
   
5.     Set Xml = CreateObject("MSXML2.XMLHTTP")
   
6.     Url = "http://lebi.17500.cn/paihang/sort/rankDetail.php?flag=lianzhun&caizhong=3d&idx=wuma&type=1&typeid=0&days=7"
   
7.     With Xml
   
8.         .Open "GET", Url, False
   
9.         .send
   
10.         Html.body.innerhtml = Split(Split(.responseText, "<ul class=""listicon"">")(1), "</ul>")(0)
    
11.     End With
    
12.     Set tb = Html.all.tags("li")
    
13.     For i = 0 To tb.Length - 1
    
14.        If tb(i).classname = "" Then
    
15.        Debug.Print tb(i).Children(1).innertext; "链接地址：" & tb(i).Children(1).href
    
16.        End If
    
17.     Next i
    
18. End Sub
    

复制代码

输出
3D免费试前独胆连准排行榜链接地址：about:rankDetail.php?flag=lianzhun&caizhong=3d&idx=dudan&type=1&typeid=0&days=7
3D免费试前双胆连准排行榜链接地址：about:rankDetail.php?flag=lianzhun&caizhong=3d&idx=shuangdan&type=1&typeid=0&days=7
3D免费试前三胆连准排行榜链接地址：about:rankDetail.php?flag=lianzhun&caizhong=3d&idx=sandan&type=1&typeid=0&days=7
3D免费试前杀一码连准排行榜链接地址：about:rankDetail.php?flag=lianzhun&caizhong=3d&idx=shayima&type=1&typeid=0&days=7
3D免费试前杀二码连准排行榜链接地址：about:rankDetail.php?flag=lianzhun&caizhong=3d&idx=shaliangma&type=1&typeid=0&days=7
3D免费试前杀三码连准排行榜链接地址：about:rankDetail.php?flag=lianzhun&caizhong=3d&idx=shasanma&type=1&typeid=0&days=7
3D免费试前五码连准排行榜链接地址：about:rankDetail.php?flag=lianzhun&caizhong=3d&idx=wuma&type=1&typeid=0&days=7
3D免费试前六码连准排行榜链接地址：about:rankDetail.php?flag=lianzhun&caizhong=3d&idx=liuma&type=1&typeid=0&days=7
3D免费试前定位连准排行榜链接地址：about:rankDetail.php?flag=lianzhun&caizhong=3d&idx=dingwei&type=1&typeid=0&days=7
3D免费试前定和值连准排行榜链接地址：about:rankDetail.php?flag=lianzhun&caizhong=3d&idx=shahewei&type=1&typeid=0&days=7
3D免费试前定跨度连准排行榜链接地址：about:rankDetail.php?flag=lianzhun&caizhong=3d&idx=shakuadu&type=1&typeid=0&days=7
3D免费试前组选连准排行榜链接地址：about:rankDetail.php?flag=lianzhun&caizhong=3d&idx=zuxuan&type=1&typeid=0&days=7

newexcel3

太强大了，谢谢大师们的无私分享。

onlycxb

1. Sub EH验证图形文字()
   
2. Dim winhttp As New winhttp.WinHttpRequest
   
3. Dim url As String, Strtxt As String
   
4. url = "http://request.touclick.com/captcharequest.touclick?js=xsreSzhCehV7S2dQJhqQLPgprgAniQQppqNBDZZGQ1a6V4dzfc5mNwXzS8bWkdtq888h1QI60MXha4xpfVn1RVQaMuHbnClC0Czwb1caS5QiUaIsxUGEpn1Ce9j2OqScWWQyKBROtoGY9cGQ0uXtHg&b=44340233-68bc-4697-8799-f361556ecefc&c=0&t=1&s=&un=&ud=0&ran=" & Rnd()
   
5. With winhttp
   
6.    .Open "GET", url, False
   
7.    .Send
   
8.    Strtxt = Replace(Split(Split(.ResponseText, "[")(2), "]")(0), "'", "")
   
9.    Debug.Print Strtxt
   
10.    Debug.Print EnCodeByHTML(Strtxt)
    
11. 
    
12. End With
    
13. End Sub
    
14. 
    
15. Function EnCodeByHTML(strText As String)
    
16.     With CreateObject("htmlfile")
    
17.         .write strText
    
18.         EnCodeByHTML = .body.innertext
    
19.     End With
    
20. End Function
    
21. 
    
22. 
    

复制代码

exceltovba

onlycxb 发表于 2014-10-14 07:57
分享2：抓取北京地铁1号线站名及换乘区间

url是在网页上怎样操作后抓的真实地址? 在fiddler里没找到这个url

onlycxb

exceltovba 发表于 2015-7-17 22:03
url是在网页上怎样操作后抓的真实地址? 在fiddler里没找到这个url

仔细找找，一定有的。

exceltovba

onlycxb 发表于 2014-10-14 07:57
分享2：抓取北京地铁1号线站名及换乘区间

抓取站名和换乘区间: 真实地址是这样获取的, 找了好长时间没找到.

exceltovba

exceltovba 发表于 2015-9-18 15:11
抓取站名和换乘区间: 真实地址是这样获取的, 找了好长时间没找到.

原因找到了, 是参数的顺序不一样了.

exceltovba

onlycxb 发表于 2014-11-5 21:14
天气网定制温度
'网址防盗,json数据responsetext:
var cityDZ101281801 ={"weatherinfo":{"city":"101281 ...

复制你的代码运行, 运行到.send时卡住, 过一会儿就报错,  是什么原因?

onlycxb

具体是哪段代码，看看是否需要前期绑定组件？或者有的网页已经变化

exceltovba

onlycxb 发表于 2015-9-18 23:09
具体是哪段代码，看看是否需要前期绑定组件？或者有的网页已经变化