VBA網(wǎng)抓規(guī)劃局規(guī)劃信息

時(shí)間：2023-04-19 03:08:01 | 來(lái)源：網(wǎng)站運(yùn)營(yíng)

時(shí)間：2023-04-19 03:08:01 來(lái)源：網(wǎng)站運(yùn)營(yíng)

VBA網(wǎng)抓規(guī)劃局規(guī)劃信息：有了上次抓取糗事百科網(wǎng)頁(yè)圖片的經(jīng)驗(yàn)，我們這次來(lái)抓取一下杭州市規(guī)劃局官網(wǎng)規(guī)劃公示信息，從2009年-2018年公示的所有規(guī)劃的規(guī)劃圖。




要發(fā)車了，各位坐穩(wěn)。




規(guī)劃局規(guī)劃公示頁(yè)面，一共110頁(yè)，3800多項(xiàng)。






















點(diǎn)開(kāi)其中一項(xiàng)以后，會(huì)出現(xiàn)項(xiàng)目規(guī)劃信息及圖片。
















咱們的目的就是抓取規(guī)劃信息中的圖片。







一、抓取思路

循環(huán)打開(kāi)110個(gè)網(wǎng)頁(yè)，在每個(gè)網(wǎng)頁(yè)中對(duì)單項(xiàng)規(guī)劃進(jìn)行循環(huán)打開(kāi)，保存其中的圖片。這次需要用到一個(gè)網(wǎng)抓利器，fiddler軟件。利用fiddler軟件抓取網(wǎng)頁(yè)提交和返回的信息，找到相應(yīng)參數(shù)，用send方法提交申請(qǐng)。




聽(tīng)著太簡(jiǎn)單了

，一句兩句說(shuō)不清，需要教程的私信我。




二、抓取效果

部分抓取的圖片，對(duì)于比較大的圖片（10m以上），抓取速度會(huì)有點(diǎn)慢。






















項(xiàng)目規(guī)劃信息網(wǎng)址、公示發(fā)布日期。
















三、代碼部分




這次抓取涉及到動(dòng)態(tài)參數(shù)的獲取，代碼有點(diǎn)多。具有動(dòng)態(tài)參數(shù)的網(wǎng)頁(yè)大多是aspx網(wǎng)頁(yè)

Sub 下載杭州市規(guī)劃局規(guī)劃()
Dim strurl$, i%, n%, arr(), b() As Byte
For i = 1 To 110 '定義提取的頁(yè)碼
strurl = "http://gh.tj.gov.cn/newslist.aspx?id=CK0401"
With CreateObject("MSXML2.XMLHTTP")
'第一次GET，獲取動(dòng)態(tài)參數(shù)VIEWSTATE和EVENTVALIDATION
.Open "GET", strurl, False
.send
strText = .responseText
VIEWSTATE = encodeURI(CStr(Split(Split(strText, "__VIEWSTATE"" value=""")(1), """ />")(0)))
EVENTVALIDATION = encodeURI(CStr(Split(Split(strText, "__EVENTVALIDATION"" value=""")(1), """ />")(0)))
strText = .responseText
VIEWSTATE = encodeURI(CStr(Split(Split(strText, "__VIEWSTATE"" value=""")(1), """ />")(0)))
EVENTVALIDATION = encodeURI(CStr(Split(Split(strText, "__EVENTVALIDATION"" value=""")(1), """ />")(0)))
'這里的翻頁(yè)動(dòng)作是POST提交類型，將取得的動(dòng)態(tài)參數(shù)寫(xiě)入需要send發(fā)送的參數(shù)中。
.Open "POST", strurl, False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.send "&__EVENTARGUMENT=" & i _
& "&__EVENTTARGET=AspNetPager1" _
& "&__EVENTVALIDATION=" & EVENTVALIDATION _
& "&__VIEWSTATE=" & VIEWSTATE _
& "&__VIEWSTATEGENERATOR=14DD91A0" _
& "&AspNetPager1_input=" & i & "-1" _
& "&HiddenFieldPageFinished=1" _
& "&pkid=CK0401" _
& "&pkid2=3" _
& "&newskindid=CK0401" _
& "&Left1$ddl_cname=CK" _
& "&Left1$tb_search=" _
& "&Left1$rbl_site=title"
strText = .responseText
'正則獲取單個(gè)規(guī)劃的網(wǎng)址信息
Open ThisWorkbook.Path & "/圖片/1.txt" For Output As #1
Print #1, strText
Close
Set reg = CreateObject("vbscript.regexp")
reg.Global = True
reg.IgnoreCase = True
reg.MultiLine = True
reg.Pattern = "<a href='(news.aspx/?id=/d+)'>(.*?)<//a><//td>/s*<td align=""right"" >(/d+-/d+-/d+)</td>"
n = 0
For Each mat In reg.Execute(strText)
n = n + 1
ReDim Preserve arr(1 To 3, 1 To n)
arr(1, n) = "http://gh.tj.gov.cn/" & mat.SubMatches(0) '正則取出的網(wǎng)址
arr(2, n) = mat.SubMatches(1) '正則取出的單項(xiàng)規(guī)劃
arr(3, n) = mat.SubMatches(2) '正則取出的規(guī)劃公示時(shí)間
Next mat
brr = Application.Transpose(arr)
rrow = ActiveSheet.Cells(Rows.Count, "a").End(3).Row + 1
ActiveSheet.Range("a" & rrow).Resize(UBound(brr), 3) = brr
'循環(huán)打開(kāi)單個(gè)規(guī)劃網(wǎng)址，保存圖形文件
Set xml = CreateObject("MSXML2.XMLHTTP")
For r = 1 To UBound(brr)
xml.Open "GET", brr(r, 1), False
xml.send
Do While xml.ReadyState <> 4
DoEvents
Loop
strr = xml.responseText
reg.Pattern = "//Files//image///d+/.jpg"
If reg.Test(strr) Then '保存網(wǎng)頁(yè)圖片
k = 0
For Each mat In reg.Execute(strr)
Set xmlhttp = CreateObject("MSXML2.XMLHTTP")
k = k + 1
xmlhttp.Open "GET", "http://gh.tj.gov.cn" & mat, False
xmlhttp.send
Do While xmlhttp.ReadyState <> 4
DoEvents
Loop
b = xmlhttp.responseBody
On Error Resume Next '排除文件名過(guò)長(zhǎng)的圖片
Open "C:/圖片/" & brr(r, 2) & k & ".jpg" For Binary As #1
Put #1, , b
Close
Next
Else
End If
Next
End With
Next
MsgBox "完成"
End Sub

Function encodeURI(strText As String) As String
With CreateObject("msscriptcontrol.scriptcontrol")
.Language = "JavaScript"
encodeURI = .Eval("encodeURIComponent('" & strText & "');")
End With
End Function

說(shuō)幾個(gè)知識(shí)點(diǎn)：① encodeURI函數(shù)，是我們自己定義的轉(zhuǎn)碼函數(shù)。

②匹配漢字和數(shù)字結(jié)合的正則表達(dá)式寫(xiě)法為：.*?




四、很粗糙的做一個(gè)數(shù)據(jù)分析（大佬輕噴......）




網(wǎng)抓了這么多數(shù)據(jù)，沒(méi)有一些感性上的認(rèn)識(shí)，都白抓取了。

將網(wǎng)抓的數(shù)據(jù)上傳到BDP個(gè)人版中，用現(xiàn)在很流行的詞云圖簡(jiǎn)單的分析了一下杭州市規(guī)劃的重點(diǎn)區(qū)域，可以看出，杭州市近幾年項(xiàng)目公示最多的區(qū)域基本都是環(huán)城四區(qū)。

事實(shí)上由于市內(nèi)六區(qū)土地利用的日益飽和，目前杭州市也在重點(diǎn)大力發(fā)展環(huán)城四區(qū)及遠(yuǎn)郊地區(qū)，一些高校和醫(yī)院等都遷往環(huán)城四區(qū)。天大，南開(kāi)新校區(qū)都在津南區(qū)。
















我的微信公眾號(hào)：VBA說(shuō)

(ID:todayvba)

歡迎來(lái)玩~

公眾號(hào)回復(fù)"網(wǎng)抓"，獲取VBA網(wǎng)抓教程。