三流君 ken3のmemo置き場

メモ置き場、保管庫として利用。まとまっていませんがヨロシク

挨拶・自己紹介:
失敗続きのAB型の変わり者 :三流プログラマー Ken3です
フリーのエンジニア・個人事業主です・・と書くと聞こえはイイが(それとなくカッコよく聞こえるが)、 現在は小さな案件の受注請負 と 短期派遣 で 日々つつましく?ほそぼそと暮らしてます。
(※詳細は[三流君 三流プログラマーとは?]を見てください)


広告:


[記事一覧、バックナンバーを見る]

久しぶりにポップアップで olicenseheartbeat.exe の 警告が表示される

f:id:ken3memo:20170727112500j:plain
久しぶりにポップアップで olicenseheartbeat.exe の 警告が表示される

とりあえず、ブロックして、

グーグルで olicenseheartbeat.exe を キーワードに検索すると、、、

https://translate.google.co.jp/translate?hl=ja&sl=en&u=https://answers.microsoft.com/en-us/msoffice/forum/msoffice_install-mso_win10/bug-correct-digital-signature-certificate-on/4cf803cf-d373-4f3f-aaac-5d110f730e80&prev=search
より

C:¥Program Files¥Microsoft Office¥root¥VFS¥ProgramFilesCommonX64¥Microsoft Shared¥OFFICE16¥OLicenseHeartbeat.exeは現在、信頼されたルート証明書で署名されていないMSIT test codesignで署名されています。 これにより、アンチウィルスやファイアウォールのような製品のダウンストリームにエラーメッセージが表示されます。 正してください。 ファイルバージョン16.0.8229.2103。


http://systemexplorer.net/ja/file-database/file/olicenseheartbeat-exe
が見つかる。

少し、様子見かなぁ・・・

ブロック後、One driveのログイン画面が表示され、
キャンセルする。。。
※ウインドウが閉じて、そのあと DOS窓が一瞬表示される・・
 なんか イヤな感じがするなぁ。

ウイルスチェックは今のところ、大丈夫ですが・・・

JRA オッズ取得 Click処理を共通化後 単勝オッズ人気順にチャレンジ

無音でミス収録したライブ動画にあとから音声解説を追加しました。
タイミングが合っていない場面がありますが、よろしくお願いします。

【VBA IE操作】JRA オッズ取得 Click処理を共通化後 単勝オッズ人気順にチャレンジ - YouTube
www.youtube.com

1.ドキュメントのリンク オブジェクトを押す処理を共通化

.Document.Links(i)
のリンクを探して押す処理を外側に出してみます。
※サブルーチン化してみます

パターン的には、
表示中のIE と 条件を渡し クリックさせる

2.共通化のサブ関数ができたので、
 これを使い、
 人気順の単勝オッズ取得を作成してみる
 ※簡単にいくといいけど、
  ライブ中に挫折したりして、、、

作成した共通関数ソースコード

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

'IEオブジェクトを受け取り、表示を待つ
Sub IE_WAIT(objIE As InternetExplorer)

    Sleep 250  '0.25秒待つ

    'ページの表示完了を待ちます。
    While objIE.ReadyState <> READYSTATE_COMPLETE Or objIE.Busy = True '.ReadyState <> 4の間まわる。
        'DoEvents  '重いので嫌いな人居るけど。
        Sleep 200  '0.2秒待つ
    Wend

    Sleep 250  '0.25秒待つ

End Sub


'IEのリンクオブジェクトから文字列をInStrで探してクリックする
Sub IE_Link_InnerHTML_InStr_Click(objIE As InternetExplorer, strINSTR As String)

    Dim i As Integer
    Dim objA As HTMLAnchorElement

    'リンクから受け取った文字列を探して押す
    For i = 0 To objIE.Document.Links.Length - 1
        '文字列を見つけたら クリック
        If InStr(objIE.Document.Links(i).innerHTML, strINSTR) > 0 Then '内側のHTML
            Set objA = objIE.Document.Links(i)  '見つけたAタグオブジェ(リンク)を代入
            objA.Click   '該当するリンクを押す
            'objA.FireEvent ("onClick")  'onClick イベントを発行
            Exit For '見つけたのでループを抜ける
        End If
    Next i

End Sub

単勝人気順オッズ取り込み

Sub ie_test_単勝人気順()  'JRA 単勝オッズの取り込み 人気順テスト

'IEの起動
    Dim objIE As InternetExplorer '変数を定義します。
    Set objIE = CreateObject("InternetExplorer.Application") 'オブジェクトを作成します。
    objIE.Visible = True      '可視、Trueで見えるようにします。
    
'表示位置(左上の座標)とサイズ(高さ・幅)を調整する
    objIE.FullScreen = False '※Trueのモードだとびっくりするよ
    objIE.Top = 0      '左上 上位置
    objIE.Left = 0     '左上 左位置
    objIE.Width = 800    '横幅
    objIE.Height = 600   '高さ
    
'XXXバー、外観・外枠の調整。
    objIE.Toolbar = True     'タブの切り替えで必要なので、ツールバーを表示にする
    objIE.MenuBar = False    'メニューは非表示にする
    objIE.AddressBar = True  'URLなど アドレスバーは確認のため、表示する
    objIE.StatusBar = True   '一番下のステータスバーを表示。

'JRA TOP ページの表示
    '処理したいページを表示します。
    objIE.Navigate "http://www.jra.go.jp/"  '.Navigate メソッドで JRA表示する。

    Call IE_WAIT(objIE)   'ページの表示完了を待ちます。
    
'TOPページが表示されたので、表示された文章に対して、処理を行います。
       
    Dim i     As Integer '添え字 i番目などで使用
    Dim yLINE As Integer '行カウンタ、Y行目
    
    Dim oDocument As HTMLDocument
    Dim objA As HTMLAnchorElement

    Dim objTABLEs As Object 'TABLE複数の格納用
    Dim objTABLE As HTMLTable 'テーブル単体
    
    Dim x As Integer  '列の管理
    Dim y As Integer  '行の管理
    
    Dim SET_Y As Integer  'Excel側のセット位置
    Dim SET_X As Integer  'Excel側のセット位置
    
    Dim objCELL As HTMLTableCell

    Dim nRACE As Integer   'レース 1-12
    Dim strRACE As String  '文字列 1Rなどを作るため


'リンクからオッズを押す
    Call IE_Link_InnerHTML_InStr_Click(objIE, "オッズ")
    Call IE_WAIT(objIE)   'ページの表示完了を待ちます。

'開催日を探す
    Dim strJYOBOX(10) As String
    Dim j As Integer
    
    '開催日のリンクをあさる
    j = 0
    For i = 0 To objIE.Document.Links.Length - 1
        '右端の"日"を条件に判断する
        If Right(objIE.Document.Links(i).innerText, 1) = "日" Then '内側のTEXT
           Set objA = objIE.Document.Links(i)  '見つけたAタグオブジェ(リンク)を代入
           Debug.Print objA.innerText
           strJYOBOX(j) = objA.innerText
           strJYOBOX(j + 1) = "END"
           j = j + 1
         End If
    Next i

    If j = 0 Then  'エラーのチェック
        MsgBox "開催日が見つかりません、"
        Exit Sub
    End If

'出力先をクリアする
    'まず、書き込み先シート、データをクリアする
    Cells.Delete Shift:=xlUp 'シート全体を削除する
    Range("A1").Select       '先頭A1を選択する、

    SET_Y = 0  'セット位置を初期化

'場所単位のループ
j = 0
While strJYOBOX(j) <> "END"  'ENDになるまで

    '開催日のリンクをあさる
    Set objA = Nothing
    For i = 0 To objIE.Document.Links.Length - 1
        '開催場所を条件に判断する
        If objIE.Document.Links(i).innerText = strJYOBOX(j) Then '内側のTEXT
           Set objA = objIE.Document.Links(i)  '見つけたAタグオブジェ(リンク)を代入
           objA.Click   '開催日を押す
           Exit For '見つけたのでループを抜ける
        End If
    Next i
    
    If objA Is Nothing Then
        MsgBox strJYOBOX(j) & " リンクが見つかりませんでした"
        Exit Sub
    End If

    Call IE_WAIT(objIE)   'ページの表示完了を待ちます。


'1R-12R 単勝の表を取り込む
    
    '1Rから12Rまで、ループする。※これだと前日発売の時1Rでトラブルなぁ
    For nRACE = 1 To 12  '一から十二まで
        
        strRACE = nRACE & "R"   'R1など 文字にする
    
        'レース番号をセルに書く
        SET_Y = SET_Y + 1
        Cells(SET_Y, 1) = strJYOBOX(j) & " " & strRACE
        SET_Y = SET_Y + 1
        
        'リンクから該当するレースを探しクリックする "1R".."12R"
        Call IE_Link_InnerHTML_InStr_Click(objIE, """" & strRACE & """")
        Call IE_WAIT(objIE)   'ページの表示完了を待ちます。
        
        'リンクから 人気順を探して押す
        Call IE_Link_InnerHTML_InStr_Click(objIE, "人気順")
        Call IE_WAIT(objIE)   'ページの表示完了を待ちます。
    
        '単勝の表を取り込む
        '表、テーブルを探る
        'テーブルを探す
        'タグの取出しが、.getElementsByTagName("TABLE")で 可能なので、
        
        'TABLEタグを抜き 複数のテーブルをセット
        Set objTABLEs = objIE.Document.getElementsByTagName("TABLE")
        '↑で代入したオブジェクトからテーブルデータを取り出す。
        
        Set objTABLE = Nothing  'オブジェクトを空にする
        For i = 0 To objTABLEs.Length - 1  'テーブル数分回す
            If objTABLEs(i).Rows(0).Cells(0).innerText = "人気" Then '左上が人気を見つける
                Set objTABLE = objTABLEs(i)  'i盤目を代入
                Exit For
            End If
        Next i
        
        '↑で見つかったかチェックする
        If objTABLE Is Nothing Then
            MsgBox "人気のテーブルが見つかりません"
            Exit Sub  'エラー表示して抜ける
        End If
        
        
        '表をDATAシートに書き出す
        
        'Webの表をシートへ転記(代入する)
        For y = 0 To objTABLE.Rows.Length - 1  '行のループ
            SET_X = 1
            For x = 0 To objTABLE.Rows(y).Cells.Length - 1  '列数分ループ
                ' objTABLE.rows(行).cells(列)
                Set objCELL = objTABLE.Rows(y).Cells(x)
                
                '結合セル、枠などに対応
                If objCELL.rowSpan > 1 Then  '縦に複数の時
                    Cells(SET_Y + 1, SET_X) = objCELL.innerText  '下にも同じくセット
                    'ホントはループがいいけど、一枠に三頭までなので
                    If objCELL.rowSpan = 3 Then  '3頭め 8枠18番など・・
                        Cells(SET_Y + 2, SET_X) = objCELL.innerText
                    End If
                End If
                            
                '既にデータありか、縦に結合されているか?
                If Len(Trim("" & Cells(SET_Y, SET_X))) > 0 Then
                    SET_X = SET_X + 1  '縦結合を飛ばすために横に移動
                End If
                
                Cells(SET_Y, SET_X) = objCELL.innerText  'データセット
                
                '横に結合されているか判断じゃなかった、横にカラム分移動
                SET_X = SET_X + objCELL.colSpan  '横に移動 通常は1 結合なし
            Next
            SET_Y = SET_Y + 1
        Next
        SET_Y = SET_Y + 1  '空白を一行追加
    Next

    j = j + 1  '次の場所へ
    
    '開催日選択にもどす
    'リンクから開催日選択を押す
    Call IE_Link_InnerHTML_InStr_Click(objIE, "開催選択へ戻る")
    Call IE_WAIT(objIE)   'ページの表示完了を待ちます。
    
Wend


'処理が終わったので、IEを閉じます。
    'テストの時は、↓確認して、残しておくと便利ですよ。
    If MsgBox("IEを閉じますか?", vbYesNo) = vbYes Then '終了確認
        objIE.Quit  '.Quitで閉じる
    End If
    
    Set objIE = Nothing '使用したオブジェクト変数もキレイにしてね。
   
End Sub

単勝馬番順オッズ取り込み

Sub ie_test()  'JRA 単勝オッズの取り込み 馬番順テスト

'IEの起動
    Dim objIE As InternetExplorer '変数を定義します。
    Set objIE = CreateObject("InternetExplorer.Application") 'オブジェクトを作成します。
    objIE.Visible = True      '可視、Trueで見えるようにします。
    
'表示位置(左上の座標)とサイズ(高さ・幅)を調整する
    objIE.FullScreen = False '※Trueのモードだとびっくりするよ
    objIE.Top = 0      '左上 上位置
    objIE.Left = 0     '左上 左位置
    objIE.Width = 800    '横幅
    objIE.Height = 600   '高さ
    
'XXXバー、外観・外枠の調整。
    objIE.Toolbar = True     'タブの切り替えで必要なので、ツールバーを表示にする
    objIE.MenuBar = False    'メニューは非表示にする
    objIE.AddressBar = True  'URLなど アドレスバーは確認のため、表示する
    objIE.StatusBar = True   '一番下のステータスバーを表示。

'JRA TOP ページの表示
    '処理したいページを表示します。
    objIE.Navigate "http://www.jra.go.jp/"  '.Navigate メソッドで JRA表示する。

    Call IE_WAIT(objIE)   'ページの表示完了を待ちます。
    
'TOPページが表示されたので、表示された文章に対して、処理を行います。
       
    Dim i     As Integer '添え字 i番目などで使用
    Dim yLINE As Integer '行カウンタ、Y行目
    
    Dim oDocument As HTMLDocument
    Dim objA As HTMLAnchorElement

    Dim objTABLEs As Object 'TABLE複数の格納用
    Dim objTABLE As HTMLTable 'テーブル単体
    
    Dim x As Integer  '列の管理
    Dim y As Integer  '行の管理
    
    Dim SET_Y As Integer  'Excel側のセット位置
    Dim SET_X As Integer  'Excel側のセット位置
    
    Dim objCELL As HTMLTableCell

    Dim nRACE As Integer   'レース 1-12
    Dim strRACE As String  '文字列 1Rなどを作るため


'リンクからオッズを押す
    Call IE_Link_InnerHTML_InStr_Click(objIE, "オッズ")
    Call IE_WAIT(objIE)   'ページの表示完了を待ちます。

'開催日を探す
    Dim strJYOBOX(10) As String
    Dim j As Integer
    
    '開催日のリンクをあさる
    j = 0
    For i = 0 To objIE.Document.Links.Length - 1
        '右端の"日"を条件に判断する
        If Right(objIE.Document.Links(i).innerText, 1) = "日" Then '内側のTEXT
           Set objA = objIE.Document.Links(i)  '見つけたAタグオブジェ(リンク)を代入
           Debug.Print objA.innerText
           strJYOBOX(j) = objA.innerText
           strJYOBOX(j + 1) = "END"
           j = j + 1
         End If
    Next i

    If j = 0 Then  'エラーのチェック
        MsgBox "開催日が見つかりません、"
        Exit Sub
    End If

'出力先をクリアする
    'まず、書き込み先シート、データをクリアする
    Cells.Delete Shift:=xlUp 'シート全体を削除する
    Range("A1").Select       '先頭A1を選択する、

    SET_Y = 0  'セット位置を初期化

'場所単位のループ
j = 0
While strJYOBOX(j) <> "END"  'ENDになるまで

    '開催日のリンクをあさる
    Set objA = Nothing
    For i = 0 To objIE.Document.Links.Length - 1
        '開催場所を条件に判断する
        If objIE.Document.Links(i).innerText = strJYOBOX(j) Then '内側のTEXT
           Set objA = objIE.Document.Links(i)  '見つけたAタグオブジェ(リンク)を代入
           objA.Click   '開催日を押す
           Exit For '見つけたのでループを抜ける
        End If
    Next i
    
    If objA Is Nothing Then
        MsgBox strJYOBOX(j) & " リンクが見つかりませんでした"
        Exit Sub
    End If

    Call IE_WAIT(objIE)   'ページの表示完了を待ちます。


'1R-12R 単勝の表を取り込む
    
    '1Rから12Rまで、ループする。※これだと前日発売の時1Rでトラブルなぁ
    For nRACE = 1 To 12  '一から十二まで
        
        strRACE = nRACE & "R"   'R1など 文字にする
    
        'レース番号をセルに書く
        SET_Y = SET_Y + 1
        Cells(SET_Y, 1) = strJYOBOX(j) & " " & strRACE
        SET_Y = SET_Y + 1
        
        'リンクから該当するレースを探しクリックする "1R".."12R"
        Call IE_Link_InnerHTML_InStr_Click(objIE, """" & strRACE & """")
        Call IE_WAIT(objIE)   'ページの表示完了を待ちます。
    
        '単勝の表を取り込む
        '表、テーブルを探る
        'テーブルを探す
        'タグの取出しが、.getElementsByTagName("TABLE")で 可能なので、
        
        'TABLEタグを抜き 複数のテーブルをセット
        Set objTABLEs = objIE.Document.getElementsByTagName("TABLE")
        '↑で代入したオブジェクトからテーブルデータを取り出す。
        
        Set objTABLE = Nothing  'オブジェクトを空にする
        For i = 0 To objTABLEs.Length - 1  'テーブル数分回す
            If objTABLEs(i).Rows(0).Cells(0).innerText = "枠番" Then '左上が枠番を見つける
                Set objTABLE = objTABLEs(i)  'i盤目を代入
                Exit For
            End If
        Next i
        
        '↑で見つかったかチェックする
        If objTABLE Is Nothing Then
            MsgBox "枠番のテーブルが見つかりません"
            Exit Sub  'エラー表示して抜ける
        End If
        
        
        '表をDATAシートに書き出す
        
        'Webの表をシートへ転記(代入する)
        For y = 0 To objTABLE.Rows.Length - 1  '行のループ
            SET_X = 1
            For x = 0 To objTABLE.Rows(y).Cells.Length - 1  '列数分ループ
                ' objTABLE.rows(行).cells(列)
                Set objCELL = objTABLE.Rows(y).Cells(x)
                
                '結合セル、枠などに対応
                If objCELL.rowSpan > 1 Then  '縦に複数の時
                    Cells(SET_Y + 1, SET_X) = objCELL.innerText  '下にも同じくセット
                    'ホントはループがいいけど、一枠に三頭までなので
                    If objCELL.rowSpan = 3 Then  '3頭め 8枠18番など・・
                        Cells(SET_Y + 2, SET_X) = objCELL.innerText
                    End If
                End If
                            
                '既にデータありか、縦に結合されているか?
                If Len(Trim("" & Cells(SET_Y, SET_X))) > 0 Then
                    SET_X = SET_X + 1  '縦結合を飛ばすために横に移動
                End If
                
                Cells(SET_Y, SET_X) = objCELL.innerText  'データセット
                
                '横に結合されているか判断じゃなかった、横にカラム分移動
                SET_X = SET_X + objCELL.colSpan  '横に移動 通常は1 結合なし
            Next
            SET_Y = SET_Y + 1
        Next
        SET_Y = SET_Y + 1  '空白を一行追加
    Next

    j = j + 1  '次の場所へ
    
    '開催日選択にもどす
    'リンクから開催日選択を押す
    Call IE_Link_InnerHTML_InStr_Click(objIE, "開催選択へ戻る")
    Call IE_WAIT(objIE)   'ページの表示完了を待ちます。
    
Wend


'処理が終わったので、IEを閉じます。
    'テストの時は、↓確認して、残しておくと便利ですよ。
    If MsgBox("IEを閉じますか?", vbYesNo) = vbYes Then '終了確認
        objIE.Quit  '.Quitで閉じる
    End If
    
    Set objIE = Nothing '使用したオブジェクト変数もキレイにしてね。
   
End Sub


試行錯誤のテスト動画
www.youtube.com
【VBA IE操作】JRA オッズ取得 Click処理を共通化後 単勝オッズ人気順にチャレンジ - YouTube
↑※冒頭の解説動画と同じです

JRA 単勝オッズ取得 コードまとめ と Sleep DoEventsの違いをテスト

コードまとめ と Sleep DoEventsの違い VBA IE操作 Ken3 ライブ プログラミング テスト中 です・・・ - YouTube
www.youtube.com

1.共通のコードをまとめましょう
泥縄式でコードをコピペ、
テスト 実行 修正 再テスト・・・を繰り返していると、
コードが長くなるし、
メンテもしにくいので、
共通のコードはまとめましょう。

2.ページの表示待ちをまとめる
リンクなどをクリックした後
必ず ページの表示を待っています、
ここを まず まとめてみます。
まとめ方は
Call IE_WAIT(IE) みたいに
サブ関数を呼ぶ形にします。

'IEオブジェクトを受け取り、表示を待つ
Sub IE_WAIT(objIE As InternetExplorer)

    'ページの表示完了を待ちます。
    While objIE.ReadyState <> READYSTATE_COMPLETE Or objIE.Busy = True '.ReadyState <> 4の間まわる。
        DoEvents  '重いので嫌いな人居るけど。
    Wend

End Sub

3.DoEvents と Sleepのテスト
DoEventsの空ループ※処理待ち だと
CPUがよけいにまわるので、
Sleepを使用したテストを行ってみます。

VBA API Sleep などで、
検索してAPIのコードをコピーします。
f:id:ken3memo:20170722044834j:plain

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

'IEオブジェクトを受け取り、表示を待つ
Sub IE_WAIT(objIE As InternetExplorer)

    Sleep 250  '0.25秒待つ

    'ページの表示完了を待ちます。
    While objIE.ReadyState <> READYSTATE_COMPLETE Or objIE.Busy = True '.ReadyState <> 4の間まわる。
        'DoEvents  '重いので嫌いな人居るけど。
        Sleep 200  '0.2秒待つ
    Wend

    Sleep 250  '0.25秒待つ

End Sub

共通関数にしたので、
修正個所も一か所なので
テストしやすいと思う ぉぃぉぃ

※実演で失敗したりして・・・
※※動画をライブ中継しているので、
  CPU負荷の違いが わからないかも?

↑で作成したサブ関数を呼ぶことにする
メインの処理※まだ ぜい肉、よぶんなコードが多いけど。

Sub ie_test()  'JRA 単勝オッズの取り込み テスト

'IEの起動
    Dim objIE As InternetExplorer '変数を定義します。
    Set objIE = CreateObject("InternetExplorer.Application") 'オブジェクトを作成します。
    objIE.Visible = True      '可視、Trueで見えるようにします。
    
'表示位置(左上の座標)とサイズ(高さ・幅)を調整する
    objIE.FullScreen = False '※Trueのモードだとびっくりするよ
    objIE.Top = 0      '左上 上位置
    objIE.Left = 0     '左上 左位置
    objIE.Width = 800    '横幅
    objIE.Height = 600   '高さ
    
'XXXバー、外観・外枠の調整。
    objIE.Toolbar = True     'タブの切り替えで必要なので、ツールバーを表示にする
    objIE.MenuBar = False    'メニューは非表示にする
    objIE.AddressBar = True  'URLなど アドレスバーは確認のため、表示する
    objIE.StatusBar = True   '一番下のステータスバーを表示。

'JRA TOP ページの表示
    '処理したいページを表示します。
    objIE.Navigate "http://www.jra.go.jp/"  '.Navigate メソッドで JRA表示する。

    Call IE_WAIT(objIE)   'ページの表示完了を待ちます。
    
'TOPページが表示されたので、表示された文章に対して、処理を行います。
       
    Dim i     As Integer '添え字 i番目などで使用
    Dim yLINE As Integer '行カウンタ、Y行目
    
    Dim oDocument As HTMLDocument
    Dim objA As HTMLAnchorElement

    Dim objTABLEs As Object 'TABLE複数の格納用
    Dim objTABLE As HTMLTable 'テーブル単体
    
    Dim x As Integer  '列の管理
    Dim y As Integer  '行の管理
    
    Dim SET_Y As Integer  'Excel側のセット位置
    Dim SET_X As Integer  'Excel側のセット位置
    
    Dim objCELL As HTMLTableCell

    Dim nRACE As Integer   'レース 1-12
    Dim strRACE As String  '文字列 1Rなどを作るため


'リンクからオッズを押す
    For i = 0 To objIE.Document.Links.Length - 1
        'オッズを見つけたら クリック
        If InStr(objIE.Document.Links(i).innerHTML, "オッズ") > 0 Then '内側のHTML
            Set objA = objIE.Document.Links(i)  '見つけたAタグオブジェ(リンク)を代入
            objA.Click   'オッズを押す
            'objA.FireEvent ("onClick")  'onClick イベントを発行
            Exit For '見つけたのでループを抜ける
        End If
    Next i
    Call IE_WAIT(objIE)   'ページの表示完了を待ちます。

'開催日を探す
    Dim strJYOBOX(10) As String
    Dim j As Integer
    
    '開催日のリンクをあさる
    j = 0
    For i = 0 To objIE.Document.Links.Length - 1
        '右端の"日"を条件に判断する
        If Right(objIE.Document.Links(i).innerText, 1) = "日" Then '内側のTEXT
           Set objA = objIE.Document.Links(i)  '見つけたAタグオブジェ(リンク)を代入
           Debug.Print objA.innerText
           strJYOBOX(j) = objA.innerText
           strJYOBOX(j + 1) = "END"
           j = j + 1
         End If
    Next i

    If j = 0 Then  'エラーのチェック
        MsgBox "開催日が見つかりません、"
        Exit Sub
    End If

'出力先をクリアする
    'まず、書き込み先シート、データをクリアする
    Cells.Delete Shift:=xlUp 'シート全体を削除する
    Range("A1").Select       '先頭A1を選択する、

    SET_Y = 0  'セット位置を初期化

'場所単位のループ
j = 0
While strJYOBOX(j) <> "END"  'ENDになるまで

    '開催日のリンクをあさる
    Set objA = Nothing
    For i = 0 To objIE.Document.Links.Length - 1
        '開催場所を条件に判断する
        If objIE.Document.Links(i).innerText = strJYOBOX(j) Then '内側のTEXT
           Set objA = objIE.Document.Links(i)  '見つけたAタグオブジェ(リンク)を代入
           objA.Click   '開催日を押す
           Exit For '見つけたのでループを抜ける
        End If
    Next i
    
    If objA Is Nothing Then
        MsgBox strJYOBOX(j) & " リンクが見つかりませんでした"
        Exit Sub
    End If

    Call IE_WAIT(objIE)   'ページの表示完了を待ちます。


'1R-12R 単勝の表を取り込む
    
    '1Rから12Rまで、ループする。※これだと前日発売の時1Rでトラブルなぁ
    For nRACE = 1 To 12  '一から十二まで
        
        strRACE = nRACE & "R"   'R1など 文字にする
    
        'レース番号をセルに書く
        SET_Y = SET_Y + 1
        Cells(SET_Y, 1) = strJYOBOX(j) & " " & strRACE
        SET_Y = SET_Y + 1
        
        'リンクから該当するレースを探しクリックする
        For i = 0 To objIE.Document.Links.Length - 1
            '"1R"など、レースを見つけたら クリック
            If InStr(objIE.Document.Links(i).innerHTML, """" & strRACE & """") > 0 Then '内側のHTML
                Set objA = objIE.Document.Links(i)  '見つけたAタグオブジェ(リンク)を代入
                objA.Click   '1Rを押す
                'objA.FireEvent ("onClick")  'onClick イベントを発行
                Exit For '見つけたのでループを抜ける
            End If
        Next i
        
        'ページの表示完了を待ちます。
        While objIE.ReadyState <> READYSTATE_COMPLETE Or objIE.Busy = True '.ReadyState <> 4の間まわる。
            DoEvents  '重いので嫌いな人居るけど。
        Wend
    
        '単勝の表を取り込む
        '表、テーブルを探る
        'テーブルを探す
        'タグの取出しが、.getElementsByTagName("TABLE")で 可能なので、
        
        'TABLEタグを抜き 複数のテーブルをセット
        Set objTABLEs = objIE.Document.getElementsByTagName("TABLE")
        '↑で代入したオブジェクトからテーブルデータを取り出す。
        
        Set objTABLE = Nothing  'オブジェクトを空にする
        For i = 0 To objTABLEs.Length - 1  'テーブル数分回す
            If objTABLEs(i).Rows(0).Cells(0).innerText = "枠番" Then '左上が枠番を見つける
                Set objTABLE = objTABLEs(i)  'i盤目を代入
                Exit For
            End If
        Next i
        
        '↑で見つかったかチェックする
        If objTABLE Is Nothing Then
            MsgBox "枠番のテーブルが見つかりません"
            Exit Sub  'エラー表示して抜ける
        End If
        
        
        '表をDATAシートに書き出す
        
        'Webの表をシートへ転記(代入する)
        For y = 0 To objTABLE.Rows.Length - 1  '行のループ
            SET_X = 1
            For x = 0 To objTABLE.Rows(y).Cells.Length - 1  '列数分ループ
                ' objTABLE.rows(行).cells(列)
                Set objCELL = objTABLE.Rows(y).Cells(x)
                
                '結合セル、枠などに対応
                If objCELL.rowSpan > 1 Then  '縦に複数の時
                    Cells(SET_Y + 1, SET_X) = objCELL.innerText  '下にも同じくセット
                    'ホントはループがいいけど、一枠に三頭までなので
                    If objCELL.rowSpan = 3 Then  '3頭め 8枠18番など・・
                        Cells(SET_Y + 2, SET_X) = objCELL.innerText
                    End If
                End If
                            
                '既にデータありか、縦に結合されているか?
                If Len(Trim("" & Cells(SET_Y, SET_X))) > 0 Then
                    SET_X = SET_X + 1  '縦結合を飛ばすために横に移動
                End If
                
                Cells(SET_Y, SET_X) = objCELL.innerText  'データセット
                
                '横に結合されているか判断じゃなかった、横にカラム分移動
                SET_X = SET_X + objCELL.colSpan  '横に移動 通常は1 結合なし
            Next
            SET_Y = SET_Y + 1
        Next
        SET_Y = SET_Y + 1  '空白を一行追加
    Next

    j = j + 1  '次の場所へ
    
    '開催日選択にもどす
    'リンクから開催日選択を押す
    For i = 0 To objIE.Document.Links.Length - 1
        '開催選択へ戻るを見つけたら クリック
        If InStr(objIE.Document.Links(i).innerHTML, "開催選択へ戻る") > 0 Then '内側のHTML
            Set objA = objIE.Document.Links(i)  '見つけたAタグオブジェ(リンク)を代入
            objA.Click   '開催選択へ戻るを押す
            'objA.FireEvent ("onClick")  'onClick イベントを発行
            Exit For '見つけたのでループを抜ける
        End If
    Next i
    Call IE_WAIT(objIE)   'ページの表示完了を待ちます。
    
Wend


'処理が終わったので、IEを閉じます。
    'テストの時は、↓確認して、残しておくと便利ですよ。
    If MsgBox("IEを閉じますか?", vbYesNo) = vbYes Then '終了確認
        objIE.Quit  '.Quitで閉じる
    End If
    
    Set objIE = Nothing '使用したオブジェクト変数もキレイにしてね。
   
End Sub

冒頭と同じ ぐだぐた 解説動画です
コードまとめ と Sleep DoEventsの違い VBA IE操作 Ken3 ライブ プログラミング テスト中 です・・・ - YouTube
www.youtube.com