Private Sub Command查询_Click()

If Me.查询股票代码 <> "" Then

Dim scode As String

scode = Me.查询股票代码

If IsNumeric(scode) = False Then

MsgBox "请输入正确股票代码"

Exit Sub

End If

Else

Exit Sub

End If

Call 获取并显示股票数据(scode)

End Sub

Public Function getstockbasicdatafun(ByVal codetext As String) As String

Dim url As String '数据获取地址

If codetext <> "" Then

url = "http://qt.gtimg.cn/q=" & codetext

With CreateObject("msxml2.XMLHTTP")

.Open "get", url, False

.Send

If UBound(Split(.responsetext, "~")) > 2 Then

getstockbasicdatafun = .responsetext

Else

getstockbasicdatafun = .responsetext

End If

End With

Else

getstockbasicdatafun = "none"

End If

End Function

Sub 获取并显示股票数据(ByVal scode As String)

On Error GoTo 错误清空

'-------------------------------处理代码

If Left(scode, 1) = 6 Then

scode = "sh" & scode

Else

scode = "sz" & scode

End If

'-------------------------------获取股票数据

Dim code_data As String

code_data = getstockbasicdatafun(scode)

If code_data = "none" Then

MsgBox "未找到该股票"

'-------------------------------清空数据

Me.股票代码 = ""

Me.名称 = ""

Me.当前价 = ""

Me.涨跌 = ""

Me.当前涨幅 = ""

Me.开盘价 = ""

Me.最高价 = ""

Me.最低价 = ""

Exit Sub

End If

'-------------------------------分割处理显示数据

Dim stockitem_array1

stockitem_array1 = Split(code_data, "~")

Me.股票代码 = stockitem_array1(2)

Me.名称 = stockitem_array1(1)

Me.当前价 = stockitem_array1(3)

Me.开盘价 = stockitem_array1(5)

Me.最高价 = stockitem_array1(41)

Me.最低价 = stockitem_array1(42)

Me.涨跌 = Round(stockitem_array1(3) - stockitem_array1(5), 2)

Me.当前涨幅 = stockitem_array1(32)

If Me.当前涨幅 >= 0 Then

Me.当前涨幅.ForeColor = RGB(255, 50, 50)

Else

Me.当前涨幅.ForeColor = RGB(50, 255, 50)

End If

Exit Sub

错误清空:

Me.股票代码 = ""

Me.名称 = ""

Me.当前价 = ""

Me.涨跌 = ""

Me.当前涨幅 = ""

Me.开盘价 = ""

Me.最高价 = ""

Me.最低价 = ""

End Sub

Private Sub Form_Timer()

If Me.股票代码 <> "" Then

Call 获取并显示股票数据(Me.股票代码)

End If

End Sub