EXCEL VBA TIPS

EXCEL VBA TIPS

PR

キーワードサーチ

▼キーワード検索

プロフィール

EXCEL VBA TIPS

EXCEL VBA TIPS

フォローする

楽天カード

カレンダー

お気に入りブログ

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

コメント新着

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

フリーページ

ニューストピックス

< 新しい記事

新着記事一覧(全54件)

過去の記事 >

2008.10.21
XML

FX投資用為替レート取得読み上げシェル選択可能にしましたVBS,WSHでのIE操作例

テーマ： FXの取引(1204)
カテゴリ： カテゴリ未分類
ブラウザ(ie)の画面を表示しレート一覧、レートのBidまたはAskを5秒間隔で読み上げます
前回の記事の変更版です。読み上げのレートをラジオボタンで選択できるようにしました。
<A href="http://sky.geocities.jp/mujintrading/">こちらのサイト</a>からログイン、レート取得などキモ部分をまるまるコピーしました。ありがとうございます
先頭2行をユーザid,パスワードの代入文に変更してください
uid=""
passwd=""
Set objIEx = CreateObject("InternetExplorer.application")
objIEx.Navigate "about:blank"
Do While objIEx.Busy

Loop
rt=8
objIEx.Width=600
objIEx.Height=700
objIEx.Visible = true
objIEx.StatusBar = True
objIEx.StatusText = t_date & " htm作成中"
objIEx.ToolBar = false
objIEx.MenuBar = false
objIEx.Document.Write "<table>"
objIEx.Document.Write "<tr><td>通貨ベア</td><td>Bid</td><td>Ask</td><td>前日終値比</td><td>Bid High</td><td>Bid Low</td><td>売Swap</td><td>買Swap</td></tr>"

objIEx.Document.Write "<tr>"
for j=0 to rt-1
objIEx.Document.Write "<td>"
if j=1 or j=2 then
objIEx.Document.Write "<input type=radio name=r>" '& cstr(i) & "_" & cstr(j) & ">"

objIEx.Document.Write "<input size=3 type=input name=f" & cstr(i) & "_" & cstr(j) & "></td>"
next
objIEx.Document.Write "</tr>"
next
objIEx.Document.Write "</table>"
objIEx.Document.Write "停止:<input type=checkbox name=term><br>"
Set Voice1 = CreateObject("SAPI.SpVoice")
Set xml = CreateObject("WinHttp.WinHttpRequest.5.1")
Set doc = CreateObject("Microsoft.XMLDOM") 'メモ　CreateObjectするより、参照設定で指定したほうが本当はいいかも。
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>"
doc.async = False '非同期をやめる。つまり同期にする。
url = BaseURL & "/ws/fx/tsukaPairList.do"
'url="https://fx.gmo.jp/fx1-1/ws/fx/tsukaPairList.do"
'引数なしなら、全通貨ペアを取得
'url="https://fx.gmo.jp/fx1-1/ws/fx/tsukaPairList.do&tka[0].tkt=1&tka[1].tkt=2"
'引数指定も可能
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
ii = 0
Do While ii < ListItems.Length And ii < 15
Set ListItem = ListItems.Item(ii)
' = ListItem.Attributes.getNamedItem("tsukaPairCode").nodeTypedValue
objIEx.document.all.tags("INPUT").item(ii*(rt+2)+0).value= ListItem.Attributes.getNamedItem("tsukaPairName").nodeTypedValue
ii = ii + 1
Loop
do
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 + "]"
WScript.Quit
End If
Set ListItems = doc.documentElement.selectSingleNode("rateList").childNodes
ii = 0
Do While ii < ListItems.Length And ii < 15
Set ListItem = ListItems.Item(ii)
objIEx.document.all.tags("INPUT").item(ii*(rt+2)+2).value =ListItem.selectSingleNode("bid").nodeTypedValue
objIEx.document.all.tags("INPUT").item(ii*(rt+2)+4).value =ListItem.selectSingleNode("ask").nodeTypedValue
objIEx.document.all.tags("INPUT").item(ii*(rt+2)+5).value = ListItem.selectSingleNode("zenjitsuhi").nodeTypedValue
objIEx.document.all.tags("INPUT").item(ii*(rt+2)+6).value = ListItem.selectSingleNode("bidHigh").nodeTypedValue
objIEx.document.all.tags("INPUT").item(ii*(rt+2)+7).value = ListItem.selectSingleNode("bidLow").nodeTypedValue
objIEx.document.all.tags("INPUT").item(ii*(rt+2)+8).value = ListItem.selectSingleNode("uriSwap").nodeTypedValue
objIEx.document.all.tags("INPUT").item(ii*(rt+2)+9).value = ListItem.selectSingleNode("kaiSwap").nodeTypedValue
ii = ii + 1
Loop
for i= 0 to 14
for j=1 to 3 step 2
if objIEx.document.all.tags("INPUT").item(i*(rt+2)+j).checked=true then
Set ListItem = ListItems.Item(i)
if j=1 then
Voice1.Speak ListItem.selectSingleNode("bid").nodeTypedValue
else
Voice1.Speak ListItem.selectSingleNode("ask").nodeTypedValue
end if
exit for
end if
next
next
If ii < ListItems.Length Then
objIEx.Document.write "通貨ペアが15件以上あります"
End If
if objIEx.Document.all.term.checked=true then exit do
WScript.Sleep (5000)
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





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

最終更新日  2008.10.21 16:21:51
コメント(0) | コメントを書く


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