求帮忙修改网抓数据错误并优优代码，谢谢

fggf

求帮忙修改网抓数据错误并优优代码，详见附件说明，谢谢！ 修改网抓数据错误并优优代码.zip (9.44 KB, 下载次数: 16)

2018-7-19 21:46 上传

点击文件名下载附件

duquancai

1. Sub main()
   
2.     Dim xmlHttp As Object, dt$, Dom As Object, nod As Object, nods As Object, k, arr()
   
3.     dt = Format(Now(), "yyyy-mm-dd")
   
4.     Set xmlHttp = CreateObject("msxml2.xmlhttp")
   
5.     Set Dom = CreateObject("htmlfile")
   
6.     xmlHttp.Open "GET", "http://www.qzzb.gov.cn:8082/ztbFiles/bidFiles/staticFiles/liveProjListStatic_" & dt & ".jsp", False
   
7.     xmlHttp.send
   
8.     Dom.body.innerhtml = xmlHttp.responsetext
   
9.     Set nod = Dom.getElementByID("LiveProject")
   
10.     Set nods = nod.all.tags("li")
    
11.     ReDim arr(1 To nods.Length, 1 To 1)
    
12.     For Each k In nods
    
13.         i = i + 1
    
14.         arr(i, 1) = k.innertext
    
15.     Next
    
16.     Range("b4").Resize(i) = arr
    
17. End Sub

复制代码