最近一直在研究VBA網抓的東西,當然,爬蟲的話首選python語言,無奈還要從新學習python。聽說VBA也能用來網抓,就查找各方面關於VBA網抓的資料學習了一下。
模仿著,也寫出來了幾個簡單的網抓小程序,深深感受到,如果學精通了網抓,整個網際網路都是你的。
這次分享的是網抓糗事百科糗圖前30頁所有糗圖的代碼,當然其他網站的圖片也是可以批量抓取的...比如百度圖片、1024、此處省略。
一、思路,最重要的還是思路。
打開糗事百科主頁,糗圖頁面。通過xmlhttp對象循環得到每一頁的網頁代碼,通過正則表達式,在網頁代碼中找到圖片的真實網頁地址,然後依次打開網址,把圖片保存到本地。
理論回頭學會了我再慢慢分享,現在我也屬於比葫蘆壺瓢階段,畢竟,興趣是最好的老師。
二、效果及代碼
我們先上效果和代碼,我都迫不及待展示了。
效果:
奉上代碼:
網抓具有時效性,網站不是一成不變的,有可能過陣子代碼就失效了,所以,思路很重要,學會思路就可以。
Sub 下載糗事百科圖片()
Dim b() As Byte
For pagenum = 1 To 30
Dim xmlhttp As Object
Set xmlhttp = CreateObject("MSXML2.XMLHTTP")
strurl = "https://www.qiushibaike.com/pic/" & "page/" & pagenum
xmlhttp.Open "GET", strurl, False
xmlhttp.send
Do While xmlhttp.ReadyState <> 4
DoEvents
Loop
strText = xmlhttp.responseText
Set reg = CreateObject("vbscript.regexp")
reg.Global = True
reg.IgnoreCase = True
reg.MultiLine = True
reg.Pattern = "pic.qiushibaike.com/system/pictures/\d+/\d+/medium/app\d+.jpeg"
Set Match = reg.Execute(strText)
For Each mat In Match
n = n + 1
xmlhttp.Open "GET", "https://" & mat, False
xmlhttp.send
Do While xmlhttp.ReadyState <> 4
DoEvents
Loop
b = xmlhttp.responseBody
Open ThisWorkbook.Path & "\圖片\" & n & ".jpg" For Binary As #1
Put #1, , b
Close
Next
Next
MsgBox "完成"
End Sub
說幾個知識點:
① reg.Pattern = "pic.qiushibaike.com/system/pictures/\d+/\d+/medium/app\d+.jpeg"
這裡是為了通過正則匹配到圖片的真實網址。
② b = xmlhttp.responseBody
Open ThisWorkbook.Path & "\圖片\" & n & ".jpg" For Binary As #1
Put #1, , b
Close
把傳輸的照片寫入圖片文件,需要以二進位形式打開並保存。
三、VBA網抓常用方法
1、xmlhttp/winhttp法:
用xmlhttp/winhttp模擬向伺服器發送請求,接收伺服器返回的數據。
優點:效率高,基本無兼容性問題。
缺點:需要藉助如fiddler的工具來模擬http請求。
2、IE/webbrowser法:
創建IE控制項或webbrowser控制項,結合htmlfile對象的方法和屬性,模擬瀏覽器操作,獲取瀏覽器頁面的數據。
優點:這個方法可以模擬大部分的瀏覽器操作。所見即所得,瀏覽器能看到的數據就能用代碼獲取。
缺點:各種彈窗相當煩人,兼容性也確實是個很傷腦筋的問題。上傳文件在IE裡根本無法實現。
3、QueryTables法:
因為它是excel自帶,所以勉強也算是一種方法。其實此法和xmlhttp類似,也是GET或POST方式發送請求,然後得到伺服器的response返回到單元格內。
優點:excel自帶,可以通過錄製宏得到代碼,處理table很方便
。代碼簡短,適合快速獲取一些存在於原始碼的table裡的數據。
缺點:無法模擬referer等發包頭
引自:http://club.excelhome.net/thread-1159783-1-1.html吳姐寫的教程
本次分享的小程序用到的用的就是第一種方法中的xmlhttp法。
xmlhttp法常用代碼框架:
Sub Main()
DimstrText As String
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", "", False
.send
strText = .responseText
Debug.Print strText
EndWith
End Sub
簡單的網頁,只需要填空就行。複雜的需要涉及到工具分析。
這次先分享到這裡,VBA網抓會繼續學習,爭取抓取出海量有深度的內容。