VBAにてウェブサイトのテーブルの内容を取得したい

Question

VBAで当ECサイトの商品の情報を取得したいと思っています。
商品はhttps://example.com?id=1のようにidで管理されています。
ただし、販売中止などにより中には404ページになるidも含まれております。

商品の情報はtableタグ内に存在しており、th,tdタグ内の情報をエクセルに移したいと考えています。

そこで以下のようにVBAを作成したのですが、1つ目の商品の処理が終わるとIEが「動作を停止しました」というエラーがでて2つ目以降の商品情報をとることができません。
デバックすると
objIE.navigate "http://example.com?id=" & j
の箇所が黄色くなっています。

商品数はとりあえず5としています。

初歩的なところで間違えているかもしれませんが、あれこれ試しても一向に解決しないため質問させていただきました。
お手数ですがどなたかご回答いただけますでしょうか。

Sub product()
    Dim i As Long
    Dim j As Long
  
    Dim objITEM As Object
    Dim objIE As New InternetExplorer
    objIE.Visible = True
    
    For j = 1 To 5
        objIE.navigate "http://example.com?id=" & j
        Call untilReady(objIE)
  
        Range("A1").CurrentRegion.Offset(1, 0).ClearContents
        i = 2
        For Each objITEM In objIE.document.querySelectorAll("th, td")
            Cells(i, j) = objITEM.innerText
                i = i + 1
        Next
    Next
    objIE.Quit
    Set objITEM = Nothing
    Set objIE = Nothing
End Sub

Sub untilReady(objIE As Object, Optional ByVal WaitTime As Integer = 10)
    Dim starttime As Date
    starttime = Now()
    Do While objIE.Busy = True Or objIE.readyState <> READYSTATE_COMPLETE
        DoEvents
        If Now() > DateAdd("S", WaitTime, starttime) Then
            Exit Do
        End If
    Loop
    DoEvents
End Sub

試したこと
1.WaitTimeを10から1000に変更→結果、変化なし

Sub untilReady(objIE As Object, Optional ByVal WaitTime As Integer = 1000)

2.UntilReadyを削除し、Sleepを使用→結果、変化なし

Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)

Sub maker()
    Dim i As Long
    Dim j As Long

    Dim objITEM As Object
    Dim objIE As New InternetExplorer
    objIE.Visible = True
    
    For j = 1 To 5
        objIE.navigate "http://example.com?id=" & j
        Sleep 1000
        Range("A1").CurrentRegion.Offset(1, 0).ClearContents
        i = 2
        For Each objITEM In objIE.document.querySelectorAll("th, td")
            Cells(i, j) = objITEM.innerText
                i = i + 1
        Next
    Next
    objIE.Quit
    Set objITEM = Nothing
    Set objIE = Nothing
End Sub

Comments

[m.ts10806]

多重起動の線が怪しそうです。
forで回さず、1つだけだとどうでしょうか。

[m.ts10806]

あとはSleepを試してみてください。

[unotalk]

ありがとうございます。
頂いたアドバイスを試してみました。
・1つめのforを削除して、j=1で固定してみましたが、以下の結果でした。
結果：
IEは問題が発生したため終了しました→プログラムの終了→このWebページに問題があるためIEのタブを開き直しました。
・Sleepの実行
以下のコードを1行目に追記
Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)
以下のコードをSleep 20000 と入れ替え
Call untilReady(objIE)
結果、上記と同じくIEの動作は停止しましたとなります。
他に、untilReadyのwaitTimeを1000に変更しましたが、同じでした。。

Answer 1

untilReadyで完全に読み込みが終わっていないのに終了している可能性はないでしょうか？
（まだ途中なのにIEに次の要求が来てしまっておかしくなっている）
今の作りだとタイムアウトの10秒が過ぎると読み込みが終わっていなくても関数を抜けてしまうと思います。
試しにタイムアウトをなしにするか、時間を長く設定してみてはいかがでしょうか。

Comments

[TanakaHiroaki]

unotalk さん

IE11の表示待ちが原因の場合、下記のサブルーチンを使ってみてください。
https://teratail.com/questions/162078#reply-242657

また、Sleep関数でエラーが出る場合、コメントアウトすると動きます。

[unotalk]

ttyp03さん
ありがとうございます。タイムアウトを1000秒まで伸ばしてみましたが、残念ながら同じ結果でした。

[ttyp03]

1000秒まで達しているのでしょうか？
その前にループを抜けてますか？
1000秒まで達しているなら更に伸ばしてみる必要はあるかと思いますし、達していないなら別の要因になるので、現象を切り分けるためにも確認してみてください。

[unotalk]

1000秒まで達しているということはないと思います。1000秒たつ前にエラーが発生しているので。。

[unotalk]

TanakaHiroakiさん
ありがとうございます！試してみます。