デバッグ JRA HP表示変更で単勝オッズの取り込みに失敗 F12で要素を確認して修正する

だいぶ前に試作した(試作したとか予防線を張りつつ、ぉぃぉぃ)
取り込みに失敗すると連絡をいただく

有料ソフトに組み込んだサブルーチンが動かなくて困っています。

12/5にJRAがHPの仕様を変更したためだと思うのですが、
単勝オッズ取り込みが出来なくなってしまいました。
「枠番のテーブルが見つかりません」
というメッセーッジボックスが出るので

単勝オッズ取り込みができない
はやくなおせカス

などなど、氷山の一角でこれだけ反応があったので、
怖いなぁ・・と思いつつ、デバッグを開始する

1.バグ・不具合の再現

2.原因の特定処置・対策

2.1 レース番号が押されていない
strRACE = nRACE & "R" 'R1など文字にする
が
変更になった
strRACE = nRACE & "レース" 'R1など文字にする

2.2 レースの取り込み結果で枠番が取れていない

imgのaltから枠の文字次の数値を取り出す
'imgのaltから枠の文字次の数値を取り出す
Waku_n = InStr(objCELL.innerHTML, "枠")
If Waku_n > 0 Then
'img alt="枠4青" src="/JRADB/img/waku/4.png">

ページの内容が変更されたので、リンクが押せなかったり、値の取得がおかしくなったりした時は、
落ち着いて、現物 IEでページを表示させ
F12 で DOM Explorer を起動後、要素の確認をすねといいですよ。
f:id:ken3memo:20181209170804j:plain

下記、そんなデバッグ動画です。
JRA 単勝オッズの取り込みに失敗バグの再現と修正 Excel2016 VBA IE表の取り込み - YouTube
www.youtube.com

一つでもデバッグ時の参考となれば幸いです。

修正したExcel2016のブックを
test/20181209.zip
↑からダウンロードして遊んでみてください。

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


Public Function JRA_Bodyからオッズの時刻を返す(objIE As InternetExplorer) As String

    Dim strTEMP As String
    Dim strRETURN As String  'リターン値
    Dim n As Integer
    
    'errでリターン値を初期化
    strRETURN = "ERR 文字列が見つかりませんでした"
    
    'HTMLのBODYテキストを代入
    strTEMP = objIE.Document.body.innerText

    'まず最終オッズを探す
    If InStr(strTEMP, "最終オッズ") > 0 Then
        strRETURN = "最終"
    End If

    '探す 13時03分現在オッズ  2018/12/09 修正
    '次週確認 7時03分現在オッズ 一けた台の時刻の時
    n = InStr(strTEMP, "現在オッズ")
    If n > 0 Then
        strRETURN = Mid(strTEMP, n - 6, 6)  '時刻を取り出す
    End If

    'リターン値をセット
    JRA_Bodyからオッズの時刻を返す = strRETURN

End Function

Public Function JRA_Bodyから発走時刻を返す(objIE As InternetExplorer) As String

    Dim strTEMP As String
    Dim strRETURN As String  'リターン値
    Dim n As Integer
    
    'errでリターン値を初期化
    strRETURN = "発走時刻が見つかりませんでした"
    
    'HTMLのBODYテキストを代入
    strTEMP = objIE.Document.body.innerText

    '5回中山4日 発走時刻：13時05分
    n = InStr(strTEMP, "発走時刻")
    If n > 0 Then
        strRETURN = Mid(strTEMP, n + 5, 6)  '後ろの時刻を取り出す
    End If

    'リターン値をセット
    JRA_Bodyから発走時刻を返す = strRETURN

End Function

'-----------------------------------------

Sub ie_単勝オッズ_シートから場所とレース指定()  '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などを作るため

    '2018/12/08
    Dim Waku_n As Integer
    Dim Waku_str As String

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


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

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

'出力先をクリアする
    'まず、書き込み先シート、データをクリアする
    Sheets("単勝馬番順").Select  'シートの切り替え
    Cells.Delete Shift:=xlUp 'シート全体を削除する
    Range("A1").Select       '先頭A1を選択する、


'1R-12R 単勝の表を取り込む
    SET_Y = 0  'セット位置を初期化
    
    '1Rから12Rまで、ループする。※これだと前日発売の時1Rでトラブルなぁ
    For nRACE = 1 To 12  '一から十二まで
        'B5からのフラグが立っていたらレースを取り込む
        If Sheets("MENU").Range("B4").Offset(nRACE, 0) = 1 Then
            strRACE = nRACE & "レース"   'レース 文字にする
        
            'レース番号をセルに書く
            SET_Y = SET_Y + 1
            Cells(SET_Y, 1) = Sheets("MENU").Range("B2") & " " & 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)
                    
                    'X=0 一番左端の枠の時 見出し行より下(y>0)で
                    If y > 0 And x = 0 Then  '枠と馬番
                        'imgのaltから枠の文字 次の数値を取り出す
                        Waku_n = InStr(objCELL.innerHTML, "枠")
                        If Waku_n > 0 Then
                            'img alt="枠4青" src="/JRADB/img/waku/4.png"></td
                            Waku_str = Mid(objCELL.innerHTML, Waku_n + 1, 1)
                            Cells(SET_Y, SET_X) = Waku_str  'データセット
                            
                            '結合セル、枠などに対応
                            If objCELL.rowSpan > 1 Then  '縦に複数の時
                                
                                Cells(SET_Y + 1, SET_X) = Waku_str  '下にも同じくセット
                                'ホントはループがいいけど、一枠に三頭までなので
                                If objCELL.rowSpan = 3 Then  '3頭め ８枠18番など・・
                                    Cells(SET_Y + 2, SET_X) = Waku_str
                                End If
                            End If
                        Else  '枠じゃなく、馬番の時
                            '既にデータありか、縦に結合されているか？
                            If Len(Trim("" & Cells(SET_Y, SET_X))) > 0 Then
                                SET_X = SET_X + 1  '縦結合を飛ばすために横に移動
                            End If
                            
                            Cells(SET_Y, SET_X) = objCELL.innerText  'データセット
                        End If
                    Else
                        '結合セル以外
                        Cells(SET_Y, SET_X) = objCELL.innerText  'データセット
                    End If
                    
                    '横に結合されているか判断じゃなかった、横にカラム分移動
                    SET_X = SET_X + objCELL.colSpan  '横に移動 通常は1 結合なし
                Next
                SET_Y = SET_Y + 1
            Next
            SET_Y = SET_Y + 1  '空白を一行追加
            
        End If  'フラグが立っていたら↑
        
    Next

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


'-----------------------------------------

Sub ie_単勝オッズ_シートから場所とレース指定_シート別()  '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)   'ページの表示完了を待ちます。


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

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

'1R-12R 単勝の表を取り込む
    
    '1Rから12Rまで、ループする。※これだと前日発売の時1Rでトラブルなぁ
    For nRACE = 1 To 12  '一から十二まで
        'B5からのフラグが立っていたらレースを取り込む
        If Sheets("MENU").Range("B4").Offset(nRACE, 0) = 1 Then
        
            '出力先をクリアする
            'まず、書き込み先シート、データをクリアする
            Sheets(nRACE & "R").Select  'シートの切り替え
            Cells.Delete Shift:=xlUp 'シート全体を削除する
            Range("A1").Select       '先頭A1を選択する、
            SET_Y = 0  'セット位置を初期化
        
            strRACE = nRACE & "R"   'R1など 文字にする
        
            'リンクから該当するレースを探しクリックする "1R".."12R"
            Call IE_Link_InnerHTML_InStr_Click(objIE, """" & strRACE & """")
            Call IE_WAIT(objIE)   'ページの表示完了を待ちます。
        
            'レース番号をセルに書く
            SET_Y = SET_Y + 1
            Cells(SET_Y, 1) = Sheets("MENU").Range("B2") & " " & strRACE
            Cells(SET_Y, 2) = JRA_Bodyからオッズの時刻を返す(objIE)
            Sheets("MENU").Range("B4").Offset(nRACE, 1) = JRA_Bodyからオッズの時刻を返す(objIE)
            Debug.Print JRA_Bodyからオッズの時刻を返す(objIE)
            
            'Debug.Print nRACE
            
            'Debug.Print objIE.Document.body.getElementsByClassName("cTtl headerOdds")(0).innerText
            'Debug.Print objIE.Document.body.getElementsByClassName("headerOdds2")(0).innerText
            
            'Debug.Print objIE.Document.body.getElementsByClassName("TtlNMnonDK headerOdds4")(0).innerText
            'Debug.Print objIE.Document.body.getElementsByClassName("headerOdds3")(0).innerText
            
            SET_Y = SET_Y + 1
        
            '単勝の表を取り込む
            '表、テーブルを探る
            'テーブルを探す
            'タグの取出しが、.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頭め ８枠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  '空白を一行追加
            
        End If  'フラグが立っていたら↑
        
    Next

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