現役プログラマー村健の、投資に役立つプログラムを作るための勉強ブログです。 自動売買、システムトレードに挑戦!します。 勉強と習得の成果を記録です。
本ブログについて
本ブログは、プログラマー観点で投資への対費用効果を上げるために何ができるか?を考えていくブログです。
基本的には、ツール作成・公開、投資に関わるプログラム情報、最終的には 完全なる自動売買を目指しています。

現在、HPの方で現在作成中のツールや発注ロジックなどを公開中です。
上記の広告は1ヶ月以上更新のないブログに表示されています。
新しい記事を書く事で広告が消せます。

ブログランキングのクリックにご協力お願いします<(__)>
FC2ブログランキング
blogRanking
くる株・株ブログランキング
株・投資ランキング
VBAでYahooにログインするマクロを組んでみました。
そんなに試験をしてないのでバグがあるかもしれませんが。

改造すれば証券会社のログインや発注もできると思います。

使い回しができやすいように、標準モジュールにいくつかの命令を
まとめました。

今後、色々な証券会社への発注できるものを作ったり、
標準モジュールを整備したりしたいですね。


'作成者:村健
'V0.01
'使い方
'このモジュールファイルをインポートしてください
'メニュー→ツール→参照設定で「Microsoft HTML Object Library」を追加してください。
Option Explicit

Public objIE As Object 'IEオブジェクト参照用

'=================================================
'名前   :初期設定
'機能概要 :IEオブジェクトの作成、可視設定など
'引数   :なし
'戻り値  :なし
'タイミング:IEオブジェクトを使用する前に必ず実行する
'=================================================
Sub SetInitialize()

    'インターネットエクスプローラーのオブジェクトを作る
    Set objIE = CreateObject("InternetExplorer.application")

    objIE.Visible = True '見えるようにする

End Sub

'=================================================
'名前   :Webアクセス
'機能概要 :指定したURLをオープンする。
'引数   :URL
'戻り値  :Webアクセス失敗。ページがない、タイムアウト等
'タイミング:IEオブジェクトを使用する前に必ず実行する
'=================================================
Function UrlAccess(url As String) As Boolean

    'URLを開く
    objIE.Navigate url
    
    '開けるまでまつ
    UrlAccess = UrlAccess_Wait
    
End Function

'=================================================
'名前   :Webアクセスを待つ
'機能概要 :現在OPENしているページの読み込みが完了するまで待つ
'      タイムアウト検出あり
'引数   :なし
'戻り値  :Webアクセス失敗。ページがない、タイムアウト等
'タイミング:ページをOPENしたら必ず実行する
'=================================================
Function UrlAccess_Wait() As Boolean

     Dim waitTime As Date

    '読みこみ完了まで待つ
    waitTime = DateAdd("s", 20, Now()) '20秒後を算出
    
    Do While objIE.Busy = True '読み込み中なら以下を繰り返す
     DoEvents
     If waitTime < Now() Then '指定時間経過したら
     Exit Do
     End If
    Loop

    'まだbusyなら
    If objIE.Busy = True Then
     UrlAccess_Wait = False 'アクセス失敗
    End If
    
    'もし404なら
    If CompTitle("サーバーが見つかりません") = True Then
     UrlAccess_Wait = False
    End If
    UrlAccess_Wait = True 'アクセス成功

End Function

'=================================================
'名前   :htmlのタイトルの文字列と比較
'機能概要 :指定した文字と、現在開いているHTMLのTITLEタグが一致するか
'引数   :比較したい文字列
'戻り値  :一致:true、不一致:false
'タイミング:タイトルを比較したいとき
'=================================================
Function CompTitle(ByVal title As String) As Boolean

    Dim doc As MSHTML.HTMLDocument
    Set doc = objIE.Document
    
    'タイトルを取得
    If title = doc.title Then
     CompTitle = True
    Else
     CompTitle = False
    End If

End Function
WebAccess.bas


Option Explicit

Private Sub CommandButton1_Click()
    'ログイン
    StockLogin
End Sub

Private Sub CommandButton2_Click()
    If objIE.Visible = True Then
     objIE.Visible = False
    Else
     objIE.Visible = True
    End If

End Sub


'ログイン実行処理
Private Sub StockLogin()
    
    SetInitialize

    If UrlAccess(Cells(2, 3).Value) <> True Then
     MsgBox ("アクセスエラー")
    End If
    
    objIE.Document.all.login.Value = Cells(3, 3).Value
    objIE.Document.all.passwd.Value = Cells(4, 3).Value
    objIE.Document.forms(0).Submit
    
    If UrlAccess_Wait <> True Then
     MsgBox ("アクセスエラー")
    End If
    
End Sub
Sheet1

VBA_LOGIN


ブログランキングのクリックにご協力お願いします<(__)>
FC2ブログランキング
blogRanking
くる株・株ブログランキング
株・投資ランキング
コメント
この記事へのコメント
コメントを投稿する
URL:
Comment:
Pass:
秘密: 管理者にだけ表示を許可する
 
トラックバック
この記事のトラックバックURL
http://investprogrammers.blog70.fc2.com/tb.php/32-9619a8da
この記事にトラックバックする(FC2ブログユーザー)
この記事へのトラックバック
上記広告は1ヶ月以上更新のないブログに表示されています。新しい記事を書くことで広告を消せます。