JRA IPATで情報を取得 8.1 1Rから最後まで次のレースを選択繰り返す

変数を２つ作成して、
レース番号とオッズの種類を覚えます。
Dim nR 'レース数
Dim strR_NAME(13) 'レース通常連番だからいらないんだけど・・・

'SELECTのタグを集める .getElementsByTagName("SELECT")を使用
Set objSELECT = objIE.Document.getElementsByTagName("SELECT")

nR = objSELECT.Item("s").OPTIONs.Length  'レース数を代入
For n = 0 To objSELECT.Item("s").OPTIONs.Length - 1
    strR_NAME(n) = objSELECT.Item("s").OPTIONs(n).innerTEXT  '名前を代入
Next

レースの数を取得したら、あとは、ループ処理で、
'ループ、頭から終わりのレースまでループさせる
For r = 0 To nR - 1 '上↑で保存したレース数分まわる
でまわし、
レースの選択、決定を繰り返しながら1R-12Rまでのオッズを出力します。

テスト結果と操作動画: http://www.youtube.com/watch?v=atKqUg03sRs
www.youtube.com

'複数立ち上がったIEから IPAT　投票メニューを見つける

    Set objIE = getIE_URL("//www.ipat.jra.go.jp/pw_020_i.cgi")

    '見つけたかチェック
    If objIE Is Nothing Then
        wscript.Echo "エラー 投票メニューが見つかりません ログインを確認してください"
        wscript.quit
    End If   

'↑上で見つけたIPAT　投票メニューから 情報メニュー を 押す

    Call IE_A_Click(objIE, "情報メニュー")   'Aタグの 情報メニューを押す
    Set objIE = Nothing  'メニューはもう使わないので  
    WScript.Sleep  5000  '5秒待つ 1000で1秒

'次は、新しく起動した IPAT情報メインメニュー を 探す

    Set objIE = getIE_URL("//info.ipat.jra.go.jp/p/s")

    '見つけたかチェック
    If objIE Is Nothing Then
        wscript.Echo "エラー IPAT情報メインメニュー 見つかりません"
        wscript.quit
    End If   


'SELECT name=m の 開催地オプションを選択する

    'SELECTのタグを集める .getElementsByTagName("SELECT")を使用
    Set objSELECT = objIE.Document.getElementsByTagName("SELECT")

    'ループで頭から表示してみる
    Set objM = Nothing
    For n = 0 To objSELECT.Length - 1
        '※.Nameで判断する
        If objSELECT(n).Name = "m" Then
            Set objM = objSELECT(n)  '見つけたname=mを新しくオブジェクト変数に代入
            exit For  'ループを抜ける
	End If
    Next

    Set objSELECT = Nothing  'オブジェクト変数解放

    '見つけたかチェック
    If objM Is Nothing Then
        msgbox "エラー 開催地 Name=m が 見つかりません"
        wscript.quit
    End If   

'次に下のオプションを探る 競馬場・開催地を保存する

    Dim nJYO             '開催数
    Dim strJYO_NAME(10)  '開催地名前 10もいらないけど

    nJYO = objM.OPTIONs.Length  '数を代入
 
    '中身をループで表示
    For n = 0 To objM.OPTIONs.Length - 1
        strJYO_NAME(n) = objM.OPTIONs(n).innerTEXT  '名前を代入
    Next 

    'テストで 0 頭を選択する ※0 1 2 3 
    objM.OPTIONs(0).selected = True   '単純にselectedプロパティをTrueでセレクト状態にする
    Call IE_INPUT_Click_VALUE(objIE, "決定")    '決定を押し、開催地を切り替える

'表示を待つ※競馬場・開催地の切り替えを待つ
    Call IE_WAIT

'オッズのボタンを押す ※一番最初に見つかったボタンを押す(ここではレース無視)
    Call IE_INPUT_Click_VALUE(objIE, "オッズ")    'オッズを押し、表示を切り替える

'表示を待つ※オッズの切り替えを待つ
    Call IE_WAIT

'5.レース番号 と オッズの種類を覚える

    Dim nR             'レース数
    Dim strR_NAME(13)  'レース 通常連番だからいらないんだけど・・・ 

    'SELECTのタグを集める .getElementsByTagName("SELECT")を使用
    Set objSELECT = objIE.Document.getElementsByTagName("SELECT")

    nR = objSELECT.Item("s").OPTIONs.Length  'レース数を代入
 
    '中身をループで表示 レース
    For n = 0 To objSELECT.Item("s").OPTIONs.Length - 1
        strR_NAME(n) = objSELECT.Item("s").OPTIONs(n).innerTEXT  '名前を代入
    Next 

    Set objSELECT = Nothing   '一度クリアじゃないけど、キレイにする

'ループ、頭から終わりのレースまでループさせる
  For r = 0 To nR - 1  '上↑で保存したレース数分まわる

    '改めて、レースの選択 SELECTを取得する
    'SELECTのタグを集める .getElementsByTagName("SELECT")を使用
    Set objSELECT = objIE.Document.getElementsByTagName("SELECT")   

    'レース番号を選択
    objSELECT.Item("s").SelectedIndex = r  '上から r 番目のレースを選択
    WScript.Sleep  500  '0.5秒待ってから

    '単勝オッズを選択
    objSELECT.Item("g").Value = "Ota01"  'Ota01 固定をセット(単・複・枠連オッズ)を代入
    WScript.Sleep  500  '0.5秒待ってから

    Set objSELECT = Nothing  'オブジェクト変数解放

'6.決定を押し、レースとオッズを切り替える
    Call IE_INPUT_Click_VALUE(objIE, "決定")    '決定を押し、レースとオッズを切り替える

'表示を待つ※オッズの切り替えを待つ
    Call IE_WAIT

'7.オッズの表を取得(出力する)
    'テーブルを抜き出す

    'TABLEのタグを集める .getElementsByTagName("TABLE")を使用
    Set objTABLE = objIE.Document.getElementsByTagName("TABLE")

    'ループで頭から 中身を表示してみる
    For n = 0 To objTABLE.Length - 1
        If objTABLE(n).Rows(0).Cells(0).InnerTEXT = "枠番" Then
            Exit For  'ループを抜ける
        End If
    Next

    '↑みつけたテーブルからデータを抜きます
    '↓.Lengthで行と列を取り出し、２重ループさせる
    For y = 0 To objTABLE(n).Rows.Length - 1  '行のループ
        strLINE = ""  '空の文字列で初期化
        For x = 0 To objTABLE(n).Rows(y).Cells.Length - 1  '列のループ
            '.InnerTextで中身の文字列を取り出し &でつなげ ,カンマを付ける
            strLINE = strLINE & objTABLE(n).Rows(y).Cells(x).InnerText & ","
        Next  'テーブルの列 x の ループ
        '作成した文字列(1行分↑)を出力する
        strLINE = strR_NAME(r) & "," & strLINE  '頭にレース番号を追加する 
        Wscript.ECHO strLINE    '一番後ろのゴミカンマは気にしない(ぉぃぉぃ)
    Next  'テーブルの行 y の ループ

  Next  'レース r のループ


'サブルーチンなど

'URLを受け取り、IEを探し、リターン値として返す
Function getIE_URL(sURL)

    'オブジェクトを格納する変数
    Dim objShell, objWindow
    Dim objRET  'リターン

    'シェルのオブジェクトを作成する
    Set objShell = CreateObject("Shell.Application")

    Set objRET = Nothing   'リターン値を初期化する    
    'ウインドウの数だけまわすぞ
    For Each objWindow In objShell.Windows
        'TypeNameでオブジェクト変数のタイプを表示する
        'HTMLDocumentだったら
        If TypeName(objWindow.document) = "HTMLDocument" Then
           If InStr(objWindow.document.URL, sURL) > 0 Then   'URLが含まれているか？
               Set objRET = objWindow '見つけたウインドウを(IE)を代入
               Exit For   
           End IF
        End If
    Next
    Set objShell = Nothing

    Set getIE_URL = objRET     'リターン値をセット(値を返す)

End Function

'Aタグ
'oIE と クリックする文字列を受け取り、見つけたら.Click する
'(※InStrの手抜き処理なので、京都と東京都に注意 完全一致は InnerTEXTで=にする)
Sub IE_A_Click(oIE, sHTML)
    'Aのタグを集める .getElementsByTagName("A")を使用
    Set objA = oIE.Document.getElementsByTagName("A")

    'ループで頭から表示してみる
    For n = 0 To objA.Length - 1
        '※.InnerHTMLじゃなくて、.OuterHTMLでAの全体を見る
        'リンクを探す、ソースの文字を探す
        If InStr(objA(n).OuterHTML, sHTML) > 0 Then  '文字を見つけたら
            objA(n).Click  'クリックする
            Exit For  'ループを抜ける
        End If
    Next

    Set objA = Nothing  'オブジェクト変数解放
End Sub

'INPUTのタグ、.Valueで比べる
'oIE と クリックする値を受け取り、見つけたら.Click する
Sub IE_INPUT_Click_VALUE(oIE, sVALUE)
    'INPUTのタグを集める .getElementsByTagName("INPUT")を使用
    Set objINPUT = oIE.Document.getElementsByTagName("INPUT")

    'ループで頭から表示してみる
    For n = 0 To objINPUT.Length - 1
        '※.valueで値を見る
        If objINPUT(n).Value = sVALUE Then
            objINPUT(n).Click  'みつけたボタンを押す
            exit For  'ループを抜ける
	end If
    Next

    Set objINPUT = Nothing

End Sub

'IEの表示完了を待つ
Sub IE_WAIT()

    WScript.Sleep  500  '0.5秒待ってから
    
    'ページの表示完了を待ちます。
    While objIE.ReadyState <> 4 Or objIE.Busy = True '.ReadyState <> 4の間まわる。
        WScript.Sleep  100  '0.1秒待つ 1000で1秒
    Wend

    WScript.Sleep  1500  '関数を抜ける前におまけで1.5秒待つ(ぉぃぉぃ)

End Sub