EXCEL VBA TIPS

キーワードサーチ

▼キーワード検索

プロフィール

EXCEL VBA TIPS

フォローする

楽天カード

カレンダー

お気に入りブログ

バンの日記 バン3105さん
Ｌｅｎｏ★ROOM レノママ♪さん
ＲＳ　うけぽの独り言 うけぽさん
ＬＡＨＡＩＮＡ’ｓ … lahaina13さん
ウサといっ緒　今日… チェシゃ猫さん

コメント新着

RaymondArout@ Безопасность Впервые с начала противостояния в украи…

RaymondArout@ Сенаторы Впервые с начала противостояния в украи…

RaymondArout@ Санкции Впервые с начала операции в украинский …

Harveytoogs@ сериалы онлайн сезон Элита сериалы он-лайн шара в течение пр…

RaymondArout@ Демократы Впервые с начала спецоперации в украинс…

フリーページ

2008.11.13

かざか証券QUICK情報よりリアルタイム値を取得する関数VBS,WSH,IE操作

テーマ：株式投資日記(19684)

カテゴリ：カテゴリ未分類

かざか証券のQUICK情報のIE画面があること(http://qweb15-2.qhit.net/livedoor2で始まる画面)
引数
objIE:かざか証券のQUICK情報のIE画面のオブジェクトを返す
meigara：検索する銘柄コードを指定する
a：株価他を返す配列、a(1):現在値,a(2):前日比,他をソース参照してください
Function kabuka_f(objIE,meigara,a)
Set objFRAME = objIE.document.frames
If InStr(objIE.document.URL, "http://qweb15-2.qhit.net") > 0 Then 'livedoor
Set objDOC = objFRAME("quick_menu").document

If objElement.Name = "KEY1" Then
objElement.Value = meigara
End If
If objElement.Value = "GO" Then
objElement.Click
Exit For
End If
Next
Call ie_wait(objIE)
Set objDOC = objFRAME("quick_main").document
s = objDOC.body.innerhtml

If InStr(s, "貸") > 0 Then
a(12) = "貸"
Else
a(12) = ""
End If

s = strmid(s, "<TH class=midashi noWrap width=""60%"">", "")
a(0) = strmid(s, "　", "<") '銘柄名
s = strmid(s, ">現値</TD>", "")
a(1) = strmid(s, "+2>", "円") '現在値
s = strmid(s, ">前日比</TD>", "")
s = strmid(s, "color=", "")
a(2) = strmid(s, ">", "<") '前日比
s = strmid(s, ">売気配</TD>", "")
a(4) = strmid(s, "</FONT>", "<") '売り値
a(3) = strmid(s, "color=#c61484>", "<") '売り数量
If IsNumeric(a(3)) = True Then
a(3) = a(3) * 1000
Else
a(3) = 0
End If
s = strmid(s, ">買気配</TD>", "")
a(5) = strmid(s, "</FONT>", "<") '買い値
a(6) = strmid(s, "color=#c61484>", "<") '買い数量
If IsNumeric(a(6)) = True Then
a(6) = a(6) * 1000
Else
a(6) = 0
End If
s = strmid(s, "売買高", "")
a(7) = strmid(s, "bgColor=#ffffff>", "<") '出来高
If IsNumeric(a(7)) = True Then
a(7) = a(7) * 1000
Else
a(7) = 0
End If
For i = 1 To 8
If IsNumeric(a(i)) = True Then
Else
a(i) = 0
End If
Next
a(8) = CLng(a(1)) - CLng(a(2)) 'strmid(s, "", "<") '前日終値
s = strmid(s, "始値", "")
a(9) = strmid(s, "bgColor=#ffffff>", "<") '始値
s = strmid(s, "高値", "")
a(10) = strmid(s, "/FONT>", "<") '高値
s = strmid(s, "安値", "")
a(11) = strmid(s, "/FONT>", "<") '安値
For i = 9 To 11
If IsNumeric(a(i)) = True Then
Else
a(i) = 0
End If
Next
Else 'kyouei
Set objDOC = objFRAME("LM").document
For Each objElement In objDOC.getElementsByTagName("IMG") '現物買い
If objElement.alt = "現物買" Then
objElement.Click
Exit For
End If
Next
Call ie_wait(objIE)
Set objFRAME = objIE.document.frames
Set objDOC = objFRAME("CT").document
For Each objElement In objDOC.getElementsByTagName("INPUT") '現物買い
If objElement.Name = "dscrCDsearch" Then
objElement.Value = meigara
set_m = True
End If
If objElement.Name = "list" Then
objElement.Click
Exit For
End If
Next
Call ie_wait(objIE)
s = objDOC.body.innerhtml
ss = objDOC.body.outertext
s = strmid(s, "<TD class=labelBlue>銘柄名</TD>", "")
a(0) = strmid(s, "dscr>", "<")
'If InStr(s, "銘柄名をご確認のうえ、口座区分、市場、株数、値段、執行条件を入力し") = 0 Then
' Sleep 200
' GoTo retry2
'End If
sss = "現在値"
ss = Right(ss, Len(ss) - (InStr(ss, sss) + Len(sss)) + 1)
s = Right(s, Len(s) - (InStr(s, sss) + Len(sss)) + 1)
's = Left(s, InStr(s, "<") - 1)
sss = "<TD class=labelWhite>"
s = Right(s, Len(s) - (InStr(s, sss) + Len(sss)) + 1)
a(1) = Left(s, InStr(s, "<") - 1) '現在値
sss = "<FONT class="
s = Right(s, Len(s) - (InStr(s, sss) + Len(sss)) + 1)
sss = ">"
s = Right(s, Len(s) - (InStr(s, sss) + Len(sss)) + 1)
a(2) = Left(s, InStr(s, "<") - 1) '前日比
sss = "<TD>売数量("
s = Right(s, Len(s) - (InStr(s, sss) + Len(sss)) + 1)
sss = "<TD class=labelWhite>"
s = Right(s, Len(s) - (InStr(s, sss) + Len(sss)) + 1)
a(3) = Left(s, InStr(s, "<") - 1) '売り数量
sss = "<TD class=bg"
s = Right(s, Len(s) - (InStr(s, sss) + Len(sss)) + 1)
sss = ">"
s = Right(s, Len(s) - (InStr(s, sss) + Len(sss)) + 1)
a(4) = Replace(Left(s, InStr(s, "<") - 1), " ", "") '売り値
sss = "<TD class=bg"
s = Right(s, Len(s) - (InStr(s, sss) + Len(sss)) + 1)
sss = ">"
s = Right(s, Len(s) - (InStr(s, sss) + Len(sss)) + 1)
a(5) = Replace(Left(s, InStr(s, "<") - 1), " ", "") '買い値
sss = "<TD class=labelWhite>"
s = Right(s, Len(s) - (InStr(s, sss) + Len(sss)) + 1)
a(6) = Left(s, InStr(s, "<") - 1) '買い数量
sss = "<TD class=labelWhite align=right>"
s = Right(s, Len(s) - (InStr(s, sss) + Len(sss)) + 1)
a(7) = Left(s, InStr(s, "<") - 1) '出来高
sss = "<TD class=labelWhite align=right>"
s = Right(s, Len(s) - (InStr(s, sss) + Len(sss)) + 1)
sss = "<TD class=labelWhite align=right>"
s = Right(s, Len(s) - (InStr(s, sss) + Len(sss)) + 1)
a(8) = Left(s, InStr(s, "<") - 1) '前日終値
sss = "始値"
s = Right(s, Len(s) - (InStr(s, sss) + Len(sss)) + 1)
sss = "<TD class=labelWhite align=right>"
s = Right(s, Len(s) - (InStr(s, sss) + Len(sss)) + 1)
a(9) = Left(s, InStr(s, "<") - 1) '始値
sss = "高値"
s = Right(s, Len(s) - (InStr(s, sss) + Len(sss)) + 1)
sss = "<TD class=labelWhite align=right>"
s = Right(s, Len(s) - (InStr(s, sss) + Len(sss)) + 1)
a(10) = Left(s, InStr(s, "<") - 1) '高値
sss = "安値"
s = Right(s, Len(s) - (InStr(s, sss) + Len(sss)) + 1)
sss = "<TD class=labelWhite align=right>"
s = Right(s, Len(s) - (InStr(s, sss) + Len(sss)) + 1)
a(11) = Left(s, InStr(s, "<") - 1) '安値
End If
End Function
Function strmid(org,mae,usiro)
pos = InStr(org, mae)
If pos > 0 Then
strmid = Right(org, Len(org) - pos - Len(mae) + 1)
org = strmid
pos = InStr(strmid, usiro)
If usiro = "" Then
' strmid = ""
Else
If pos > 0 Then
strmid = Left(strmid, pos - 1)
End If
End If
Else
strmid = ""
End If
End Function
Function ie_wait (objIE)
Do While objIE.busy
Loop
Do While objIE.Document.readyState <> "complete"
Loop
'if MsgBox("nuke " & Timer & " " & s_t, VbOKCancel, "WS") = vbOK Then WScript.Quit
End function

お気に入りの記事を「いいね！」で応援しよう