怎么用VBA或网络爬虫程序抓取网站数据

VBA网抓常用方法

1、xmlhttp/winhttp法：

用xmlhttp/winhttp模拟向服务器发送请求，接收服务器返回的数据。

优点：效率高，基本无兼容性问题。

缺点：需要借助如fiddler的工具来模拟http请求。

2、IE/webbrowser法：

创建IE控件或webbrowser控件，结合htmlfile对象的方法和属性，模拟浏览器 *** 作，获取浏览器页面的数据。

优点：这个方法可以模拟大部分的浏览器 *** 作。所见即所得，浏览器能看到的数据就能用代码获取。

缺点：各种d窗相当烦人，兼容性也确实是个很伤脑筋的问题。上传文件在IE里根本无法实现。

3、QueryTables法：

因为它是excel自带，所以勉强也算是一种方法。其实此法和xmlhttp类似，也是GET或POST方式发送请求，然后得到服务器的response返回到单元格内。

优点：excel自带，可以通过录制宏得到代码，处理table很方便

。代码简短，适合快速获取一些存在于源代码的table里的数据。

缺点：无法模拟referer等发包头

也可以利用采集工具进行采集网页端的数据，无需写代码。

代码：

Private Sub CommandButton1_Click()

Dim IE As Object

Dim i As Integer

i = 1

'打开网页：创建一个IE对象，然后给一些属性赋值。Visible是可见性，navigate是网页地址

Set IE = CreateObject('internetexplorer.application')

With IE

.Visible = True

.navigate 'http://hanyu.iciba.com/pinyin.html'

'等待网页完全加载

Do Until .ReadyState = 4

DoEvents

Loop

'拷贝汉字到网页文本框,然后点击转换按钮,并取出转换结果

Do While Sheets('sheet1').Cells(i 1, 1).Value <>''

'从IE.Document.all句柄中把页面上要使用的节点找出来。这里的方法是：

.document.all('source').Value 给以source为ID的文本框赋值

.document.all.tags('img')(1).Click 点击图片集合里的第二张图片

.document.all('to').Value 取出以to为ID的文本框内容

.document.all('source').Value = Sheets('sheet1').Cells(i 1, 1).Value

.document.all.tags('img')(1).Click

Do Until .ReadyState = 4

DoEvents

Loop

Sheets('sheet1').Cells(i 1, 2).Value = .document.all('to').Value

i = i 1

Loop

'关闭网页

.quit

End With

End Sub

代码解释：(见注释)

贴士：

1)VBA只能 *** 作IE浏览器，原因就一句话：都是微软家的产品嘛

2)要先引用Micorsoft Internet Controls

Sub 按钮1_Click()

Dim url, html

n = 1

url = "http://www.zjcredit.gov.cn:8000/ListQuery.aspx"

For j = 1 To 5'这里控制查询的页数

pd = "sectionID=02" _

&"&sortField=CreditID" _

&"&sortDirection=1" _

&"&recordTotal=3151" _

&"&pageNo=" &j _

&"&pageLength=20" _

&"&isOpen=False&isIntermediary=False" _

&"&query_AreaCode=" _

&"&query_OrganizationCode=" _

&"&query_BusinessLicense=" _

&"&query_CorporationName=" _

&"&query_LegalRepresentative=" _

&"&query_BusinessScope=" _

&"&query_PromptSymbol=D"

pd1 = "query_AreaCode=&query_OrganizationCode=&query_BusinessLicense=&query_CorporationName=&query_LegalRepresentative=&query_BusinessScope=&query_PromptSymbol=d&queryTitle=&businessLicense=&actionType=&searchType=&sectionID=02&hot=&returnFunction=parent.reset_queryTitles&query2_AreaCode=0&query2_BusinessLicense=&query2_CorporationName=&query2_OrganizationCode=&query2_LegalRepresentative=&validateTextbox="

Set html = CreateObject("htmlfile")

With CreateObject("msxml2.xmlhttp.6.0")

.Open "post", url, False

.setrequestheader "Content-Type", "application/x-www-form-urlencoded"

.send (pd)

html.body.innerhtml = .responsetext

Set tr = html.all.tags("tr")

For i = 0 To tr.Length - 1

If tr(i).bgcolor = "#ffffff" Or tr(i).bgcolor = "#f3f3f3" Then

n = n + 1

Cells(n, 1) = tr(i).ChildNodes(0).innertext

Cells(n, 2) = tr(i).ChildNodes(1).innertext

End If

Next

End With

Next

End Sub

Sub 按钮2_Click()

Range("a2:b65536").ClearContents

End Sub

---