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の取引(1255)
カテゴリ： カテゴリ未分類
ブラウザ(ie)の画面を表示しレート一覧、USD/JPNのBidを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
WScript.Sleep 100

rt=8
objIEx.Width=400
objIEx.Height=400
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>"
for i= 1 to 15

for j=1 to rt
objIEx.Document.Write "<td><input size=3 type=input name=f" & cstr(i) & "_" & cstr(j) & "></td>"
next
objIEx.Document.Write "</tr>"
next

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メソッド版
'url = "https://sec-sso.gmo.jp/webservice/wsfx-redirect"
'url = "https://sec-sso.click-sec.com/webservice/wsfx-redirect"
'xml.Open "POST", url, False
'xml.setRequestHeader "Content-Type", "application/x-www-form-urlencoded" '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
' Debug.Print xml.responseText

doc.loadXML (xml.responseText)
If doc.documentElement.selectSingleNode("responseStatus").nodeTypedValue <> "OK" Then
msg = doc.documentElement.selectSingleNode("message").nodeTypedValue
MsgBox "GMO側が以下のエラーを返しました" + vbCrLf + "[" + msg + "]"
' Exit Sub
End If


'シーケンス３ ユーザ認証とリダイレクトでURLをたどっていく
url = BaseURL & "/ws-login?j_username=" & uid & "&j_password=" & passwd
'url=https://fx.click-sec.com/fx1-1/ws-login?j_username=999999999&j_password=111111
'Debug.Print url

xml.Open "GET", url, False
xml.send
' Debug.Print xml.responseText

doc.loadXML (xml.responseText)
If doc.documentElement.selectSingleNode("responseStatus").nodeTypedValue = "NG" Then
If doc.documentElement.selectSingleNode("message").nodeTypedValue = "Authentication Failure." Then
MsgBox ("ユーザIDまたはパスワードが誤っています")
'Exit Sub
ElseIf doc.documentElement.selectSingleNode("message").nodeTypedValue = "Web service is not permitted." Then
'2007/04/03現在、GMOはこのエラーをかえさない。正常になる。ただし発注や一覧を問い合わせるとエラーになる
MsgBox ("GMOホームページに行って利用設定が必要です")
'Exit Sub
Else
msg = doc.documentElement.selectSingleNode("message").nodeTypedValue
MsgBox "GMO側が以下のエラーを返しました" + vbCrLf + "[" + msg + "]"
'Exit Sub
End If
ElseIf doc.documentElement.selectSingleNode("responseStatus").nodeTypedValue <> "OK" Then
msg = doc.documentElement.selectSingleNode("message").nodeTypedValue
MsgBox "GMO側が以下のエラーを返しました" + vbCrLf + "[" + msg + "]"
'Exit Sub
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
MsgBox "GMO側が以下のエラーを返しました" + vbCrLf + "[" + msg + "]"
End If

'Debug.Print xml.responseText

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+0).value= ListItem.Attributes.getNamedItem("tsukaPairName").nodeTypedValue
' = ListItem.selectSingleNode("maxTorihikiSuryo").nodeTypedValue
'= ListItem.selectSingleNode("minTorihikiSuryo").nodeTypedValue
' = ListItem.selectSingleNode("torihikiTani").nodeTypedValue
' = ListItem.selectSingleNode("yobineTani").nodeTypedValue
'2008/09/25 FX-V1.1.0版よりyobineTaniが追加

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+1).value =ListItem.selectSingleNode("bid").nodeTypedValue
if ii=0 then
Voice1.Speak ListItem.selectSingleNode("bid").nodeTypedValue
end if
objIEx.document.all.tags("INPUT").item(ii*rt+2).value =ListItem.selectSingleNode("ask").nodeTypedValue
objIEx.document.all.tags("INPUT").item(ii*rt+3).value = ListItem.selectSingleNode("zenjitsuhi").nodeTypedValue
objIEx.document.all.tags("INPUT").item(ii*rt+4).value = ListItem.selectSingleNode("bidHigh").nodeTypedValue
objIEx.document.all.tags("INPUT").item(ii*rt+5).value = ListItem.selectSingleNode("bidLow").nodeTypedValue
objIEx.document.all.tags("INPUT").item(ii*rt+6).value = ListItem.selectSingleNode("uriSwap").nodeTypedValue
objIEx.document.all.tags("INPUT").item(ii*rt+7).value = ListItem.selectSingleNode("kaiSwap").nodeTypedValue
' = ListItem.selectSingleNode("hasseibi").nodeTypedValue
' = ListItem.selectSingleNode("fuyoNissu").nodeTypedValue
' = ListItem.selectSingleNode("nichiji").nodeTypedValue
'2008/09/25 FX-V1.1.0版よりnichijiが追加

ii = ii + 1
Loop
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
'Err:
'MsgBox "エラーが発生しました" + vbCrLf + Err.Description, vbOKOnly





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

最終更新日  2008.10.21 14:54:19
コメント(0) | コメントを書く


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