网抓股票历史行情数据

'Option Explicit

Private Declare Function URLDownloadToFile Lib "urlmon" _
Alias "URLDownloadToFileA" _
(ByVal pCaller As Long, _
ByVal szURL As String, _
ByVal szFileName As String, _
ByVal dwReserved As Long, _
ByVal lpfnCB As Long) As Long
Sub DownLoadFile()
Dim sSource As String, sLocal As String
Dim hfile As Long, lSize As Long
sSource = "http://quotes.money.163.com/trade/lsjysj_600123.html"
sLocal = ThisWorkbook.Path & "\" & "600123.html"
If URLDownloadToFile(0&, sSource, sLocal, 0&, 0&) = 0 Then
hfile = FreeFile
Open sLocal For Input As #hfile
lSize = LOF(hfile)
Close #hfile
If MsgBox("删除下载文件?", vbYesNo) = vbYes Then Kill sLocal
MsgBox "共下载 " & lSize & " 字节"
End If
End Sub

Sub GetHistory()
Dim httpRequest As Object
Dim i As Integer, j As Integer
Dim strQuery As String
Dim doc As HTMLDocument
Dim dTable As HTMLTable
Application.ScreenUpdating = False
strQuery = "http://quotes.money.163.com/trade/lsjysj_" & Cells(1, 2)
strQuery = strQuery & ".html?year=" & Cells(2, 2)
strQuery = strQuery & "&season=" & Cells(3, 2)
Range("6:" & 2 ^ 20).ClearContents
Set doc = New MSHTML.HTMLDocument
Application.StatusBar = "正在获取数据..."
Set httpRequest = New MSXML2.XMLHTTP30
httpRequest.Open "GET", strQuery, False
httpRequest.setRequestHeader "Content-Type", "text/html"
httpRequest.send ""
If httpRequest.Status = 200 Then
doc.body.innerHTML = httpRequest.responseText
Set dTable = doc.all.tags("table")(3)
For i = 1 To dTable.Rows.Length - 1
For j = 0 To dTable.Rows(0).Cells.Length - 1
Cells(i + 5, j + 1) = dTable.Rows(i).Cells(j).innerText
Next j
Next i
Else
reportErr (httpRequest.Status)
End If
Application.ScreenUpdating = True
httpRequest.abort
Set doc = Nothing
Set dTable = Nothing
Set httpRequest = Nothing
Application.StatusBar = False
End Sub
Sub reportErr(lStatus As Integer)
Select Case lStatus
Case 400
MsgBox "错误请求", vbCritical, "连接错误"
Case 404
MsgBox "未发现网页", vbCritical, "连接错误"
Case 408
MsgBox "超时", vbCritical, "连接错误"
Case Else
MsgBox "其它原因不能访问", vbCritical, "连接错误"
End Select
End Sub