股票自动委托下单html,【股市擒庄神器】动态网页股票盘口信息自动循环抓取工具（纯EXCEL）...

Dim n '公用变量，记住下一个任务执行的时间

Dim ieArr()

Sub input_data()

Dim i As Integer, str As String, urlStr As String, r As Integer

'关闭描述计时器

Call stopTime

'检查监视列表，并将网页打开并放在动态数组里

If Sheets("监视列表").Cells(2, 1) = "" Then

MsgBox "请在【监视列表】表格的A列依次输入股票代码然后再操作！"

Exit Sub

End If

r = 0

For i = 2 To Sheets("监视列表").UsedRange.Rows.Count

If Sheets("监视列表").Cells(i, 1) <> "" Then

'上海和深圳股的前缀不一样，这里判断一下

If Left(Format(Sheets("监视列表").Cells(i, 1), "000000"), 1) = "6" Then

str = "sh" & Format(Sheets("监视列表").Cells(i, 1), "000000")

ElseIf Left(Format(Sheets("监视列表").Cells(i, 1), "000000"), 1) = "3" Or Left(Format(Sheets("监视列表").Cells(i, 1), "000000"), 1) = "0" Then

str = "sz" & Format(Sheets("监视列表").Cells(i, 1), "000000")

Else

MsgBox "【监视列表】中第" & "i" & "行中A列的股票代码非法，请修改后在操作。注：代码应该是6位纯数字"

Exit Sub '这里必须退出，不然打开错误的网页，程序会找不到相应的数据，会一直找下去

End If

Sheets("盘口").Cells(1, 1) = str

'将不同网页写入动态数组，以免每次打开的时候都需要重新打开网页

ReDim Preserve ieArr(r)

urlStr = "http://finance.sina.com.cn/realstock/company/" & Sheets("盘口").Cells(1, 1) & "/nc.shtml"

Set ieArr(r) = CreateObject("internetexplorer.application")

ieArr(r).Visible = False '网页不看见，注意电脑的默认浏览需要设置为IE浏览器

ieArr(r).Navigate urlStr

r = r + 1

End If

Next i

'运算计时器

Application.StatusBar = "正在打开新浪股票网，获取数据...(大概每2分钟获取1次)"

Call autoPankou   '从新浪股票网站获取盘口信息

End Sub

Sub autoPankou() '计时器每次调用

On Error Resume Next

Call gupiaoXinxi   '获取股票信息

n = Now + TimeValue("00:02:00") '设定时间间隔为2分钟

Application.StatusBar = "程序会自动新浪股票网站获取盘口信息，下次自动获取的时间(2分钟后)是：" & n

Application.OnTime n, "autoPankou" '到指定时间后再执行本过程

End Sub

Sub stopTime() '停止计时器

On Error Resume Next

'关闭网页，释放内存

Dim i As Integer

For i = LBound(ieArr) To UBound(ieArr)

ieArr(i).Quit

Set ieArr(i) = Nothing

Next i

Application.OnTime n, "autoPankou", , False '停止任务的执行

Application.StatusBar = "计时已经停止"

End Sub

Sub myClear()

Rows("2:" & ActiveSheet.UsedRange.Rows.Count + 1).Delete Shift:=xlUp

End Sub

Private Sub gupiaoXinxi() '获取股票信息'计时器会每次调用的，代码尽量优化以节约电脑资源

On Error Resume Next

Dim i As Integer, j As Integer, k As Integer, flag As Integer, arr(1 To 11, 1 To 2)

Dim nameD As String, name As String, daima As String, hqTime As String

Dim weibi As String, weicha As String, waipan As String, neipan As String

Dim endR As Long, Savetime As Single

endR = ActiveSheet.UsedRange.Rows.Count

For k = LBound(ieArr) To UBound(ieArr)

With ieArr(k)

.Refresh '让股票网页窗口一直打开，这里只刷新获取最新数据

Savetime = Timer '记下开始的时间

While Timer < Savetime + 2 '延时2秒执行

DoEvents '转让控制权，以便让操作系统处理其它的事件

Wend

hqTime = "" '时间

Do While hqTime = "" '没有找到这个ID名称的控件不准出来

hqTime = .Document.getElementById("hqTime").innertext

If .readystate = 4 Then Exit Do '网页已经加载完毕都没找到数据，就不找了

Loop

nameD = ""

Do While nameD = ""

nameD = .Document.getElementById("stockName").innertext '股票名

name = Split(nameD, "(")(0)

daima = Right(Split(nameD, ".")(0), 6) '代码

If .readystate = 4 Then Exit Do '网页已经加载完毕都没找到数据，就不找了

Loop

weibi = ""

Do While weibi = "" '没有找到这个ID名称的控件不准出来

weibi = .Document.getElementById("fiveRate").innertext '委比

If .readystate = 4 Then Exit Do '网页已经加载完毕都没找到数据，就不找了

Loop

weicha = ""

Do While weicha = "" '没有找到这个ID名称的控件不准出来

weicha = .Document.getElementById("fiveAmt").innertext '委差

If .readystate = 4 Then Exit Do '网页已经加载完毕都没找到数据，就不找了

Loop

waipan = ""

Do While waipan = "" '没有找到这个ID名称的控件不准出来

waipan = .Document.getElementById("outamt").innertext '外盘

If .readystate = 4 Then Exit Do '网页已经加载完毕都没找到数据，就不找了

Loop

neipan = ""

Do While neipan = "" '没有找到这个ID名称的控件不准出来

neipan = .Document.getElementById("inamt").innertext '内盘

If .readystate = 4 Then Exit Do '网页已经加载完毕都没找到数据，就不找了

Loop

flag = 0

Do While flag <> 22 '没有找到这个ID名称的控件不准出来

For i = LBound(arr) To UBound(arr)

For j = LBound(arr, 2) To UBound(arr, 2)

arr(i, j) = .Document.getElementById("tabfive").getElementsByTagName("tr")(i).getElementsByTagName("td")(j - 1).innertext '五档盘口

flag = flag + 1

Next j

Next i

If .readystate = 4 Then Exit Do '网页已经加载完毕都没找到数据，就不找了

Loop

'            .Quit '关闭网页,这不用关闭，下次还会用到

End With

'写入表格

With Sheets("盘口")

endR = endR + 1

.Cells(endR, 1) = Format(hqTime, "yyyy-m-d hh:mm:ss") '时间

.Cells(endR, 2) = name ' 股票名称

.Cells(endR, 3) = daima ' 代码

.Cells(endR, 4) = weibi  ' 委比

.Cells(endR, 5) = weicha ' 委差

.Cells(endR, 6) = waipan ' 外盘

.Cells(endR, 7) = neipan  ' 内盘

For i = 1 To 11

.Cells(endR, i * 2 + 6) = arr(i, 1) ' 价格

.Cells(endR, i * 2 + 7) = arr(i, 2) ' 手数

Next i

End With

Next k

End Sub