最近一直在研究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 = "" & "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等发包头引自：吴姐写的教程

本次分享的小程序用到的用的就是第一种方法中的xmlhttp法。

xmlhttp法常用代码框架：

Sub Main() DimstrText As String With CreateObject("MSXML2.XMLHTTP") .Open "GET", "", False .send strText = .responseText Debug.Print strText EndWithEnd Sub

简单的网页，只需要填空就行。复杂的需要涉及到工具分析。