HTMLDocumentからtable要素を取得したい（通常実行とステップイン実行で結果が違う）

Question

前提・実現したいこと

VBAでWebスクレイピングのコードを作成しています。
順序としては以下の順序でコードを組み立てています。
0. HTTPリクエストを投げて目標のページのHTMLソースを取得
0. HTMLソースから表部分の要素を取得
0. 各行のテキストをイミディエイトウィンドウに表示

発生している問題・エラーメッセージ

HTMLDocumentからgetElementByIdでtable要素を取得できません。
正確には、ステップイン実行で1行ずつ実行するとtable要素を取得できるのですが、普通に実行すると取得できません。
※1ページに複数のテーブルが存在し目的のtableタグにIdが設定されているので、getElementByIdを使用しています。

該当のソースコード

大変申し訳ないのですが、質問事項に関係なさそうな部分のソースコード（ワークシート操作など）は省いております。

Option Explicit

'*******************************
'*  関数名：Performer
'*  機　能：ボタン押下時にVBAを実行
'*  概　要：
'*******************************
Sub Performer()
    On Error GoTo Escape

    Dim link As String
        link = ThisWorkbook.Worksheets("Sheet1").Cells(1, 2).Value
    Dim htmlDoc As HTMLDocument
    Dim objHtmlTable As HTMLTable
    Dim objHtmlTableRow As HTMLTableRow
    Dim btn As Integer

'   HTMLDocumentを取得
    Set htmlDoc = GetHtmlDoc(link)
    
'   表部分のHTMLソースを取得
    If Not IsNull(htmlDoc.getElementById("sortabletable1")) Then
        Set objHtmlTable = htmlDoc.getElementById("sortabletable1")
    Else
        Call Err.Raise(213, "Performer", "指定の要素が見つかりませんでした")
    End If

    For Each objHtmlTableRow In objHtmlTable.getElementsByTagName("tbody")(0).getElementsByTagName("tr")
        Debug.Print objHtmlTableRow.innerText
    Next objHtmlTableRow

    btn = MsgBox("処理完了", vbOKOnly + vbInformation, "終了")
    
    Exit Sub
    
Escape:

    btn = MsgBox("処理失敗" & Chr(10) & Chr(10) & _
        Err.Number & Chr(10) & _
        Err.Source & Chr(10) & _
        Err.Description, vbOKOnly + vbInformation, "終了")

End Sub


'--------------------------------------------------------
'*  関数名：GetHtmlDoc
'*  機　能：指定のURLのHTMLソースをHTMLDocument形式で取得する
'*  補　足：
'--------------------------------------------------------
Function GetHtmlDoc(ByVal in_URL As String) As HTMLDocument
    On Error GoTo Escape
    
    Dim httpReq As XMLHTTP60
        Set httpReq = New XMLHTTP60
    Dim tmp_htmlDoc As Object
        Set tmp_htmlDoc = New HTMLDocument
    
    httpReq.Open "GET", in_URL
    httpReq.send
    
    Do While httpReq.readyState < 4
        DoEvents
    Loop
    
    tmp_htmlDoc.write httpReq.responseText
    
    Set GetHtmlDoc = tmp_htmlDoc
    
    Set httpReq = Nothing
    Set tmp_htmlDoc = Nothing
    
    Exit Function
    
Escape:
    Set httpReq = Nothing
    Set tmp_htmlDoc = Nothing
    Call Err.Raise(Err.Number, Err.Source, Err.Description)

End Function

試したこと

1. 番号リスト問題個所の特定①

普通に実行した際にエラーが発生したのは
「For Each objHtmlTableRow In objHtmlTable.getElementsByTagName("tbody")(0).getElementsByTagName("tr")」
の部分で、ローカルウィンドウを見るとobjHtmlTableがNothingだということがわかりました。


0. 番号リスト問題個所の特定②
objHtmlTableにオブジェクトをセットする部分
「Set objHtmlTable = htmlDoc.getElementById("sortabletable1")」
にブレークポイントを置いてステップイン実行してみたら、objHtmlTableに値が入りイミディエイトウィンドウにも
目的のデータが表示されました。

何度か試してみて、

• 普通にVBAを実行するとobjHtmlTableにオブジェクトがセットされず後の処理でエラーが発生する
• ステップイン実行だとobjHtmlTableにオブジェクトがセットされる

ということはわかったのですが、この事象の解決ができずにおり、皆さんのお知恵を拝借したく思います。
なお、他に提供してほしい情報などございましたらお知らせください。対応可能な範囲で提供させていただきます。

補足情報（FW/ツールのバージョンなど）

Excelはこちらを使用しています。
Microsoft® Excel® 2016 MSO (16.0.14326.20384) 32 ビット

ちなみに、スクレイピングに使用しているサイトはこちらです。
https://azurlane.wikiru.jp/index.php?%A5%AD%A5%E3%A5%E9%A5%AF%A5%BF%A1%BC%A5%EA%A5%B9%A5%C8
自分がプレイしていて大きな表があるのを知っていたのでスクレイピングにはピッタリかな～と思いましてw

Answer 1

cx20さんの回答とほぼ同じですが、リトライではなく待機処理を入れて改善できないでしょうか。

Set GetHtmlDoc = New HTMLDocument
GetHtmlDoc.body.innerHTML = httpReq.responseText

Dim FutureTime As Date
FutureTime = DateAdd("s", 10, Now)
Do While GetHtmlDoc.readyState <> "complete"
    DoEvents
    If Now > FutureTime Then Exit Do
Loop

Comments

[Irys]

ご回答いただきありがとうございます。
待機処理でも改善できました。本当にありがとうございます。

[Irys]

～さらに結果報告～

TanakaHiroakiさん、cx20さんから頂いた解答をヒントに再度色々調べてみましたが、Performer()内で
HTMLドキュメントの解析状況（.readyState）で待機・進行・タイムアウトの処理をするように
コードを組みなおしました。
※GetHtmlDoc()内で解析状況を取得しようとすると永遠に"loading"でタイムアウト時間一杯まで
　待機し続けることになってしまいました

解析状況が"loading"の場合、待機する
→ 待機から10秒以内に解析状況が"interactive"になった場合、後続処理へ進む
　→ 10秒経過して解析状況が"interactive"になった場合、エラーをスローして例外処理（タイムアウト）

ちなみにテストの結果、待機時間は平均0.45秒必要ということがわかりました。

以下ソースコードです。
↓↓↓↓↓
'HTMLDocumentを取得
Set htmlDoc = GetHtmlDoc(link)
Dim start: start = Timer
Debug.Print (start - start & "; " & htmlDoc.readyState)
Do Until htmlDoc.readyState = "interactive"
　Application.Wait Now() + TimeValue("00:00:11")　← 10秒以上でタイムアウトのテストが可能
　DoEvents
　If 10 < Timer - start Then
　　Call Err.Raise(213, "Performer", "HTMLの解析がタイムアウトしました")
　End If
Loop
Debug.Print (Timer - start & "; " & htmlDoc.readyState)

Answer 2

重い環境では読み込み終わってなくてエラーになることがあるようです。
下記にリトライの例が載っていましたので試してみてもらえますか？

■ VBAのHTTP通信でWebスクレイピング
https://blog.systemjp.net/entry/2020/04/06/142331

Comments

[Irys]

ご回答いただきありがとうございます。
記載いただいたリンクを参考にリトライ処理を組み込んだところ上手くいきました。
本当にありがとうございます。

～追伸～
>重い環境では読み込み終わってなくてエラーになることがあるようです。
確かに私のPC自体高スペックでもなければ新しいわけでもない（むしろ最近は重く感じてきた）ので、
さもありなんと言う感じですね。

また、ローカルウィンドウからhtmlDocの中身を見ようと+マークで展開したときに、時間が掛かることは
確かにありました。あれは、responseTextからwriteした内容をHTMLとして読み込む途中だった
ということなんでしょうね。
そこに気づかず申し訳ございませんでした。

[Irys]

～さらに結果報告～

cx20さん、TanakaHiroakiさんから頂いた解答をヒントに再度色々調べてみましたが、Performer()内で
HTMLドキュメントの解析状況（.readyState）で待機・進行・タイムアウトの処理をするように
コードを組みなおしました。
※GetHtmlDoc()内で解析状況を取得しようとすると永遠に"loading"でタイムアウト時間一杯まで
　待機し続けることになってしまいました

解析状況が"loading"の場合、待機する
→ 待機から10秒以内に解析状況が"interactive"になった場合、後続処理へ進む
　→ 10秒経過して解析状況が"interactive"になった場合、エラーをスローして例外処理（タイムアウト）

ちなみにテストの結果、待機時間は平均0.45秒必要ということがわかりました。

以下ソースコードです。
↓↓↓↓↓
'HTMLDocumentを取得
Set htmlDoc = GetHtmlDoc(link)
Dim start: start = Timer
Debug.Print (start - start & "; " & htmlDoc.readyState)
Do Until htmlDoc.readyState = "interactive"
　Application.Wait Now() + TimeValue("00:00:11")　← 10秒以上でタイムアウトのテストが可能
　DoEvents
　If 10 < Timer - start Then
　　Call Err.Raise(213, "Performer", "HTMLの解析がタイムアウトしました")
　End If
Loop
Debug.Print (Timer - start & "; " & htmlDoc.readyState)

[TanakaHiroaki]

Irysさん 追加での結果報告ありがとうございました。
HTMLドキュメントの解析状況（.readyState）について勉強になりました。

[cx20]

自分も readyState の interactive ステートについて知らなかったので参考になりました。
https://developer.mozilla.org/ja/docs/Web/API/Document/readyState