Excelで巡回ソフトを作ってみよう

'最新の情報に更新
Private Sub ExIeRefresh()
On Error Resume Next
    tInternetExp.Refresh2 REFRESH_COMPLETELY
End Sub


下記のコードに変更してください

'URLを開く
Private Function ExIeOpenUrl() As Boolean
    Dim starttim As Single
    
    ExIeOpenUrl = True

On Error GoTo ErrEnd
    tInternetExp.Visible = True
    tInternetExp.Navigate Range("G" & DoDispRow)

    starttim = Timer
    Do
        '完了
        If tInternetExp.ReadyState = 4 Then
            NowDispRow = DoDispRow
            Range("H" & DoDispRow) = Range("H" & DoDispRow) + 1
            Exit Do
        End If

        If Timer - starttim > 20 Then
            tInternetExp.Stop
            MsgBox "20秒経過しましたがURLをオープンできません。処理を中止します。" & vbCrLf & _
                "URL： " & Range("G" & DoDispRow)
            ExIeOpenUrl = False
            Exit Do
        End If
        DoEvents
    Loop
    If ExIeOpenUrl Then
        If CheckBox1.Value Then
            ExIeRefresh
        End If
    End If
    Exit Function
ErrEnd:
    ExIeOpenUrl = False
    MsgBox "インターネットエクスプローラーのURLオープンに失敗しました。" & vbCrLf & _
        "URL： " & Range("G" & DoDispRow) & vbCrLf & _
        Err.Description
End Function