网站抓取数据求助

savills8016

savills8016

求老师们帮忙，占用老师们的宝贵时间可以加微信，红包感谢，只盼能解决问题，谢谢！

deadzlq

PQ参考解法（貌似有反爬）

duquancai

这个没说清楚红包，哈哈

savills8016

duquancai 发表于 2019-9-30 11:04
这个没说清楚红包，哈哈

WX:13338114826

vbexcelhome

闲着没事，写了个简单的。
查询.rar (25.27 KB, 下载次数: 11)

2019-10-3 19:13 上传

点击文件名下载附件

EH_LOVE

vbexcelhome 发表于 2019-10-1 10:50
闲着没事，写了个简单的。

兄台高手 ，能否公开下源码

vbexcelhome

EH_LOVE 发表于 2019-10-1 17:50
兄台高手 ，能否公开下源码

这东西不是很复杂。论坛都有县城的教程，我把代码精简了一下提取出来分享一下。这段代码里面有个路径提取链接的函数，这个是自己写的一个模块，将路径转成元素的。这个其实不需要，可以按这个路径自己逐级去提取。这里我是为了通用性，做一个框架，如果有变化，只需要修改路径配置就行了。

vbexcelhome

代码审核时间慢点
下面是能运行的代码，精简了一下。分为两部分，1、获得价格目录列表清单，2、获得具体日期的价格表
1、获得价格列表目录

1. '获得价格列表 链接
   
2. 
   
3. strURL = "http://www.wuxi.gov.cn/fwxx/msjg/nfcp/index.shtml"
   
4.   Dim XmlHttp As Object
   
5.   Set XmlHttp = CreateObject("Microsoft.XMLHTTP")
   
6. 
   
7.   XmlHttp.Open "GET", strURL, False
   
8.   XmlHttp.send
   
9.   outerHTML = XmlHttp.responsetext
   
10.   
    
11.   outerHTML = Replace(outerHTML, "script", "")
    
12. ' Call ClearScript(outerHTML) '清除
    
13.   
    
14. '使用DOM对象解析网页
    
15.   Dim objHtmlFile As Object
    
16.   Set objHtmlFile = CreateObject("htmlfile")
    
17.   objHtmlFile.write outerHTML
    
18.   
    
19. '使用VBpath获得所有链接，添加到LIST控件
    
20. 'Set modVBpath.HtmDOM = objHtmlFile
    
21. 'Set oElements = modVBpath.GetXpathElements("div[@class='RightSide_con']\a[@href]")
    
22. 
    
23. Set oDivs = objHtmlFile.getElementsByTagName("DIV")
    
24. Debug.Print oDivs.Length
    
25. For Each Element In oDivs
    
26.     If Element.className = "RightSide_con" Then
    
27.         Set oElements = Element.getElementsByTagName("A")
    
28.     End If
    
29. Next
    
30. 
    
31. For Each Element In oElements
    
32.     If InStr(Element.href, ".shtml") Then
    
33.     Debug.Print Element.innerText, Element.href
    
34.     End If
    
35. Next

复制代码

2、获得具体日期的价格表

1. Sub test()
   
2. 
   
3. strURL = "http://www.wuxi.gov.cn/doc/2019/09/03/2629866.shtml"
   
4. 
   
5.   Dim XmlHttp As Object
   
6.   Set XmlHttp = CreateObject("Microsoft.XMLHTTP")
   
7. '获得网页内容,  strURL=网址
   
8. 
   
9. 
   
10.   XmlHttp.Open "GET", strURL, False
    
11.   XmlHttp.send
    
12.   outerHTML = XmlHttp.responsetext
    
13.   outerHTML = Replace(outerHTML, "script", "")
    
14.   
    
15. '使用DOM对象解析网页
    
16.   Dim objHtmlFile As Object
    
17.   Dim oTable As Object
    
18.   Set objHtmlFile = CreateObject("htmlfile")
    
19.   objHtmlFile.write outerHTML
    
20.   
    
21. '获得表中数据
    
22.   Set oElements = objHtmlFile.getElementsByTagName("table")
    
23.   Set oTable = oElements(0)
    
24.   Debug.Print GetTableDataText(oTable)
    
25. End Sub
    
26. 
    
27. 
    

复制代码

savills8016

vbexcelhome 发表于 2019-10-1 10:50
闲着没事，写了个简单的。

谢谢老师的辛苦！这个实在是太好用了，前几天论坛里的一个老师帮我做了一个，功能要求都达到了，但是没你这个方便，我也传上来