信息時代已經到來,該如何好好利用網絡資源?
爬蟲的話首選Python,無奈,對于我這樣半道出家非專業編程的工程人來說,學習成本確實是個問題。好在VB是當年微軟的主推,支持的庫不是最新最先進,但起碼還有的用用。拋開效率不講,VB當之無愧的是工程人員的首選。
首先關于網抓應該先了解兩樣工具:
一個是瀏覽器的F12調出來的開發人員工具。
另一個是大名鼎鼎的Fiddler。
這兩個工具用來分析網頁。
當然,對于HTML的知識也是不能少的啦。
可以參考:http://www.w3school.com.cn/html/index.asp
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法
Public Function XmlHttpData(LinkString As String) As String
Dim xmlHttp As Object
Set xmlHttp = CreateObject("MSXML2.XMLHTTP")
xmlHttp.Open "GET", LinkString, False
xmlHttp.send
Do While xmlHttp.readystate <> 4
DoEvents
Loop
XmlHttpData = xmlHttp.ResponseText
End Function
亂碼的處理:
XmlHttpData = StrConv(xmlHttp.ResponseText, vbUnicode)
最后是分析返回的數據
處理table:
可以使用split以及replace分析
或者通過正則表達式分析。
還有:
html法
將table數據寫入htmldocument對象,然后循環取出表格的各個元素。
Sub Main()
Dim strText As String
Dim arrData(1 To 1000, 1 To 3)
Dim i As Long, j As Long
Dim TR As Object, TD As Object
With CreateObject("MSXML2.XMLHTTP")
.Open "POST", "http://www.pinble.com/Template/WebService1.asmx/Present3DList", False
.setRequestHeader "Content-Type", "application/json"
.Send "{pageindex:'1',lottory:'TC7XCData_jiangS',pl3:'',name:'江蘇七星彩',isgp: '0'}"
strText = Split(JSEval(.responsetext), "<script")(0) '本例的script運行會提示錯誤,所以去除這部分script代碼
End With
With CreateObject("htmlfile")
.write strText
i = 0
For Each TR In .all.tags("table")(2).Rows
i = i + 1
j = 0
For Each TD In TR.Cells
j = j + 1
arrData(i, j) = TD.innerText
Next
Next
End With
Set TR = Nothing
Set TD = Nothing
Cells.Clear
Range("C:C").NumberFormat = "@"
Range("a1").Resize(i, 3).Value = arrData
End Sub
Function JSEval(s As String) As String
With CreateObject("MSScriptControl.ScriptControl")
.Language = "javascript"
JSEval = .Eval(s)
End With
End Function
QueryTable法
Sub Main()
Cells.Delete
With ActiveSheet.QueryTables.Add("url;http://data.bank.hexun.com/lccp/jrxp.aspx", Range("a1"))
.WebFormatting = xlWebFormattingNone '不包含格式'
.WebSelectionType = xlSpecifiedTables '指定table模式'
.WebTables = "2" '第2張table'
.Refresh False
End With
End Sub
復制粘貼法:
table部分的文字可以直接復制到單元格內,且保留數據原格式。
Sub Main()
Dim strText As String
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", "http://data.bank.hexun.com/lccp/jrxp.aspx", False
.Send
strText = .responsetext
End With
strText = "<table" & Split(Split(strText, "<table")(2), "</table>")(0) & "</table>"
CopyToClipbox strText
Cells.Clear
Range("a1").Select
ActiveSheet.Paste
End Sub
Sub CopyToClipbox(strText As String)
'文本拷貝到剪貼板'
With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
.SetText strText
.PutInClipboard
End With
End Sub
未完待續