EXCEL VBA TIPS

EXCEL VBA TIPS

PR

キーワードサーチ

▼キーワード検索

プロフィール

EXCEL VBA TIPS

EXCEL VBA TIPS

フォローする

楽天カード

カレンダー

お気に入りブログ

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

コメント新着

RaymondArout@ Безопасность Впервые с начала противостояния в украи…
RaymondArout@ Сенаторы Впервые с начала противостояния в украи…
RaymondArout@ Санкции Впервые с начала операции в украинский …
Harveytoogs@ сериалы онлайн сезон Элита сериалы он-лайн шара в течение пр…
RaymondArout@ Демократы Впервые с начала спецоперации в украинс…

フリーページ

ニューストピックス

< 新しい記事

新着記事一覧(全54件)

過去の記事 >

2008.11.04
XML

FX投資クリック証券約定読み上げシェルVBS,WSHでのIE操作例

(2)
テーマ： FXの取引(1200)
カテゴリ： カテゴリ未分類
5秒毎に約定照会し、約定があった場合、番号を読み上げます

uid=""
passwd=""
dim xml,doc,BaseURL,ask(99),bid(99),code(99),tsukaPairName(99),YakujyoBango(999)
YakujyoNum=0
YakujyoSumi=0
Set objIEx = CreateObject("InternetExplorer.application")
objIEx.Navigate "about:blank"

WScript.Sleep 100
Loop
Set xml = CreateObject("WinHttp.WinHttpRequest.5.1")
Set doc = CreateObject("Microsoft.XMLDOM")
call login(xml,doc,BaseURL,uid,passwd)
rt=GetTsukaPairName(xml,doc,BaseURL,tsukaPairName)
objIEx.Width=600
objIEx.Height=700
objIEx.Visible = true
objIEx.StatusBar = True
objIEx.StatusText = t_date & " htm作成中"

objIEx.MenuBar = false
objIEx.Document.Write "<table>"
objIEx.Document.Write "<tr><td>通貨ベア</td><td>Bid</td><td>Ask</td></tr>"
for i= 0 to rt-1
objIEx.Document.Write "<tr>"

objIEx.Document.Write "<td>"
if j=0 then
objIEx.Document.Write tsukaPairName(i) & "</td>"
else
objIEx.Document.Write "<input size=3 type=input name=f" & cstr(i) & "_" & cstr(j) & "></td>"
end if
next
objIEx.Document.Write "</tr>"
next
objIEx.Document.Write "</table>"
objIEx.Document.Write "URL<input type=input size=60 name=url><br>"
objIEx.Document.Write "エラー<input type=input size=60 name=errM><br>"
objIEx.Document.Write "状態<input type=input size=60 name=stat><br>"
objIEx.Document.Write "約定待ち間隔秒数(5秒以上にしてください)<input type=input size=2 name=Kankaku value=""5""><br>"
objIEx.Document.Write "停止:<input type=checkbox name=term><br>"
Set Voice1 = CreateObject("SAPI.SpVoice")
do
i=GetRate(xml,doc,BaseURL,ask,bid)
for ii= 0 to i-1
objIEx.document.all.tags("INPUT").item(ii*2+1).value =ask(ii)
objIEx.document.all.tags("INPUT").item(ii*2+0).value =bid(ii)
next
PreDate=Now
objIEx.document.all.stat.value="約定照会中 " & now
yakujyo=yakujyoChk(xml,dom,BaseURL,YakujyoBango,YakujyoNum)
objIEx.document.all.stat.value="約定番号読み上げ中 総数=" & YakujyoNum & " 読み上げ済み数=" & YakujyoSumi & " " & now
if YakujyoNum>YakujyoSumi then
for i=YakujyoSumi to YakujyoNum-1
Voice1.Speak YakujyoBango(i)
objIEx.document.all.stat.value="約定番号読み上げ中 総数=" & YakujyoNum & " 読み上げ済み数=" & i+1 & " " & now
next
YakujyoSumi=YakujyoNum
end if
objIEx.document.all.stat.value="待ち " & now
if objIEx.Document.all.term.checked=true then exit do
do until datediff("s",PreDate,now)>=cint(objIEx.Document.all.Kankaku.value)
wscript.sleep(1000)
loop
loop
doc.async = False '非同期をやめる。つまり同期にする。
url = BaseURL & "/ws-logout"
xml.Open "GET", url, False
xml.send
doc.loadXML (xml.responseText)
If doc.documentElement.selectSingleNode("responseStatus").nodeTypedValue <> "OK" Then
objIEx.Document.write "logout error"
else
objIEx.Document.write "logout OK"
End If
Set xml = Nothing
Set doc = Nothing

function GetTsukaPairName(xml,doc,BaseURL,tsukaPairName)
doc.async = False
url = BaseURL & "/ws/fx/tsukaPairList.do"
xml.Open "GET", url, False
xml.send
doc.loadXML (xml.responseText)
If doc.documentElement.selectSingleNode("responseStatus").nodeTypedValue <> "OK" Then
msg = doc.documentElement.selectSingleNode("message").nodeTypedValue
objIEx.Document.write "GMO側が以下のエラーを返しました" + vbCrLf + "[" + msg + "]"
End If
Set ListItems = doc.documentElement.selectSingleNode("tsukaPairList").childNodes
for ii =0 to ListItems.Length-1
Set ListItem = ListItems.Item(ii)
tsukaPairName(ii)=ListItem.Attributes.getNamedItem("tsukaPairName").nodeTypedValue
next
GetTsukaPairName=ii
end function
function GetRate(xml,doc,BaseURL,ask,bid)
doc.async = False
url = BaseURL & "/ws/fx/rateList.do"
xml.Open "GET", url, False
xml.send
doc.loadXML (xml.responseText)
If doc.documentElement.selectSingleNode("responseStatus").nodeTypedValue <> "OK" Then
msg = doc.documentElement.selectSingleNode("message").nodeTypedValue
objIEx.Document.write "GMO側が以下のエラーを返しました" + vbCrLf + "[" + msg + "]"
End If
Set ListItems = doc.documentElement.selectSingleNode("rateList").childNodes
for ii=0 to ListItems.Length-1
Set ListItem = ListItems.Item(ii)
'code(ii)=ListItem.Attributes.getNamedItem("tsukaPairCode").nodeTypedValue
ask(ii)=ListItem.selectSingleNode("ask").nodeTypedValue
bid(ii)=ListItem.selectSingleNode("bid").nodeTypedValue
next
GetRate=ii
end function
sub cancel(objIEx,xml,doc,baseUrl,bango)
doc.async = False '非同期をやめる。つまり同期にする。
url = baseUrl & "/ws/kabu/kabuChumonTorikeshi.do?"
url = url & "cmk=" & bango
xml.Open "GET", url, False
xml.send
doc.loadXML (xml.responseText)
If doc.documentElement.selectSingleNode("responseStatus").nodeTypedValue <> "OK" Then
msg = doc.documentElement.selectSingleNode("message").nodeTypedValue
MsgBox "GMO側が以下のエラーを返しました" + vbCrLf + "[" + msg + "]"
Wscript.quit
End If
msg = doc.documentElement.selectSingleNode("message").nodeTypedValue
objIEx.Document.write msg
end sub
function yakujyoChk(xml,dom,BaseURL,YakujyoBango,YakujyoNum)
YakujyoNumOrg=YakujyoNum
yakujyoChk=false
doc.async = False '非同期をやめる。つまり同期にする。
url = BaseURL & "/ws/fx/yakujoList.do?"
yfd=Year(Now) & Right("0" & Month(Now),2) & Right("0" & Day(Now), 2)
'yfd="20081020"
url=url & "yfd=" & yfd & "&ytd=" & yfd
objIEx.document.all.url.value= url
xml.Open "GET", url, False
xml.send
doc.loadXML (xml.responseText)
If doc.documentElement.selectSingleNode("responseStatus").nodeTypedValue <> "OK" Then
msg = doc.documentElement.selectSingleNode("message").nodeTypedValue
objIEx.Document.write "GMOエラーyakujoList" + vbCrLf + "[" + msg + "]" & Now & "<br>"
if msg="頻度を落としてリクエストしてください。" then
wscript.sleep(5000)
end if
End If
Set yakujoList = doc.documentElement.selectSingleNode("yakujoList").childNodes
ii=0
'shinkiChumonBango="10009818892"
For Each ListItem In yakujoList
Set ListItem = yakujoList.Item(ii)
Num=ListItem.selectSingleNode("chumonBango").nodeTypedValue
match=false
for k= 0 to YakujyoNumOrg-1
if Num=YakujyoBango(k) then
match=true
exit for
end if
next
if match=false then
YakujyoBango(YakujyoNum)=Num
YakujyoNum=YakujyoNum+1
end if
next
end function
sub login(xml,doc,BaseURL,uid,passwd)
doc.async = False '非同期をやめる。つまり同期にする。
'シーケンス１ リダイレクト先を取得
xml.option(6) = False '6=WinHttpRequestOption_EnableRedirects 'リダイレクトさせない
'GETメソッド版
'GETメソッドでも可能だったが、GMOの仕様書ではPOSTになっていた
url = "https://sec-sso.click-sec.com/webservice/wsfx-redirect?u=" & uid
'2008/03/29 URL変更
xml.Open "GET", url, False
xml.send
'POSTの場合、一般的にこの指定が必要
Location = xml.getResponseHeader("Location") 'リダイレクト先URLの取得
aa = InStr(Len("https://") + 1, Location, "/") 'https://fx.click-sec.com/ の文字列数
bb = InStr(aa + 1, Location, "/") 'https://fx.click-sec.com/fx1-1/ の文字列数
'2008/03/29　基底URL取得方法修正
BaseURL = Left(xml.getResponseHeader("Location"), bb - 1)
'基底URL = "https://fx.click-sec.com/fx1-1"
xml.option(6) = True '6=WinHttpRequestOption_EnableRedirects '以後はリダイレクトをさせる
'シーケンス２ リダイレクト先へ飛んでセッションIDを取得
url = Location
xml.Open "GET", url, False
xml.send
doc.loadXML (xml.responseText)
If doc.documentElement.selectSingleNode("responseStatus").nodeTypedValue <> "OK" Then
msg = doc.documentElement.selectSingleNode("message").nodeTypedValue
objIEx.Document.write "GMO側が以下のエラーを返しました" + vbCrLf + "[" + msg + "]"
WScript.Quit
End If
'シーケンス３ ユーザ認証とリダイレクトでURLをたどっていく
url = BaseURL & "/ws-login?j_username=" & uid & "&j_password=" & passwd
xml.Open "GET", url, False
xml.send
doc.loadXML (xml.responseText)
If doc.documentElement.selectSingleNode("responseStatus").nodeTypedValue = "NG" Then
If doc.documentElement.selectSingleNode("message").nodeTypedValue = "Authentication Failure." Then
objIEx.Document.write "ユーザIDまたはパスワードが誤っています"
WScript.Quit
ElseIf doc.documentElement.selectSingleNode("message").nodeTypedValue = "Web service is not permitted." Then
'2007/04/03現在、GMOはこのエラーをかえさない。正常になる。ただし発注や一覧を問い合わせるとエラーになる
objIEx.Document.write "GMOホームページに行って利用設定が必要です"
WScript.Quit
Else
msg = doc.documentElement.selectSingleNode("message").nodeTypedValue
objIEx.Document.write "GMO側が以下のエラーを返しました" + vbCrLf + "[" + msg + "]"
WScript.Quit
End If
ElseIf doc.documentElement.selectSingleNode("responseStatus").nodeTypedValue <> "OK" Then
msg = doc.documentElement.selectSingleNode("message").nodeTypedValue
objIEx.Document.write "GMO側が以下のエラーを返しました" + vbCrLf + "[" + msg + "]"
WScript.Quit
End If
objIEx.Document.write "Login完了<br>"
end sub





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

最終更新日  2008.11.04 18:27:34
コメント(2) | コメントを書く


【毎日開催】
15記事にいいね！で1ポイント
10秒滞在
いいね! -- / --
次の日記を探す
おめでとうございます！
ミッションを達成しました。
※「ポイントを獲得する」ボタンを押すと広告が表示されます。
x
© Rakuten Group, Inc.
Design a Mobile Site
スマートフォン版を閲覧 | PC版を閲覧
    Share by: