基于新浪行情接口和VBA的Excel股票行情自动定时抓取模板
'更新当前价格价格数据（昨收、现价）
Sub upDateCurHq()
Dim orgCode As String, dataGot, dataSplit
Dim itemCount As Byte, hkCount As Byte
Dim i As Byte, ExchRate As Double
Dim urlList As String
Dim NetStatus As Integer
Dim arrHisData() As Double
' Application.ScreenUpdating = False
Sheets('flitter').Activate
ExchRate = NetOk
If ExchRate < 0 Then Exit Sub
With CreateObject('MSXML2.XMLHTTP')
.Open 'Get', 'http://hq.sinajs.cn/?list=h_RMBHKD', False
.Send
ExchRate = Split(.responseText, ',')(4) / 100
End With
i = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
Range('I5', Cells(i, 10)).ClearContents
[I4] = '昨收'
[J4] = '现价'
'按代码类别排序股票
With ActiveSheet.AutoFilter.Sort
.SortFields.Clear
.SortFields.Add Key:=Range('B4'), Order:=xlAscending
.Apply
End With
'查询RMB对HKD的汇率
hkCount = 0
itemCount = Sheets('flitter').Cells(Rows.Count, 2).End(xlUp).Row '最下面的股票代码所在行号
If itemCount <= 5 Then Exit Sub
'获得查询url的股票list
For i = 5 To itemCount
orgCode = LCase(Cells(i, 2))
If Left(orgCode, 2) = 'hk' Then
orgCode = 'rt_hk' & Right(orgCode, 5)
hkCount = hkCount + 1
End If
urlList = urlList & ',' & orgCode
Next i
'获得所有股票行情数据
With CreateObject('MSXML2.XMLHTTP')
.Open 'GET', 'http://hq.sinajs.cn/list=' & Right(urlList, Len(urlList) - 1), False
.Send
dataGot = Split(.responseText, ''';' & Chr(10))
End With
'获取港股昨收价和现价
For i = 5 To hkCount + 4
dataSplit = Split(dataGot(i - 5), ',')
With Sheets('flitter')
.Cells(i, 9) = Round(dataSplit(3) * ExchRate, 3) '昨收价-港股
.Cells(i, 10) = Round(dataSplit(6) * ExchRate, 3) '现价-港股
' .Cells(i, 14) = .Cells(i, 14) / Range('汇率') * ExchRate '参照日价格按汇率变化进行调整
End With
Next i
'获取A股昨收价和现价
For i = hkCount + 5 To itemCount
dataSplit = Split(dataGot(i - 5), ',')
With Sheets('flitter')
.Cells(i, 9) = Round(dataSplit(2), 3) '昨收价 - A股
.Cells(i, 10) = Round(dataSplit(3), 3) '现价 - A股
End With
Next i
Range('汇率') = ExchRate
'恢复按flitter提供顺序排序
With ActiveSheet.AutoFilter.Sort
.SortFields.Clear
.SortFields.Add Key:=Range('A4'), Order:=xlAscending
.Apply
End With
End Sub