|
本帖最后由 vbexcelhome 于 2019-10-3 19:14 编辑
代码审核时间慢点
下面是能运行的代码,精简了一下。分为两部分,1、获得价格目录列表清单,2、获得具体日期的价格表
1、获得价格列表目录
- '获得价格列表 链接
- strURL = "http://www.wuxi.gov.cn/fwxx/msjg/nfcp/index.shtml"
- Dim XmlHttp As Object
- Set XmlHttp = CreateObject("Microsoft.XMLHTTP")
- XmlHttp.Open "GET", strURL, False
- XmlHttp.send
- outerHTML = XmlHttp.responsetext
-
- outerHTML = Replace(outerHTML, "script", "")
- ' Call ClearScript(outerHTML) '清除
-
- '使用DOM对象解析网页
- Dim objHtmlFile As Object
- Set objHtmlFile = CreateObject("htmlfile")
- objHtmlFile.write outerHTML
-
- '使用VBpath获得所有链接,添加到LIST控件
- 'Set modVBpath.HtmDOM = objHtmlFile
- 'Set oElements = modVBpath.GetXpathElements("div[@class='RightSide_con']\a[@href]")
- Set oDivs = objHtmlFile.getElementsByTagName("DIV")
- Debug.Print oDivs.Length
- For Each Element In oDivs
- If Element.className = "RightSide_con" Then
- Set oElements = Element.getElementsByTagName("A")
- End If
- Next
- For Each Element In oElements
- If InStr(Element.href, ".shtml") Then
- Debug.Print Element.innerText, Element.href
- End If
- Next
复制代码 2、获得具体日期的价格表
- Sub test()
- strURL = "http://www.wuxi.gov.cn/doc/2019/09/03/2629866.shtml"
- Dim XmlHttp As Object
- Set XmlHttp = CreateObject("Microsoft.XMLHTTP")
- '获得网页内容, strURL=网址
- XmlHttp.Open "GET", strURL, False
- XmlHttp.send
- outerHTML = XmlHttp.responsetext
- outerHTML = Replace(outerHTML, "script", "")
-
- '使用DOM对象解析网页
- Dim objHtmlFile As Object
- Dim oTable As Object
- Set objHtmlFile = CreateObject("htmlfile")
- objHtmlFile.write outerHTML
-
- '获得表中数据
- Set oElements = objHtmlFile.getElementsByTagName("table")
- Set oTable = oElements(0)
- Debug.Print GetTableDataText(oTable)
- End Sub
复制代码
|
|