投稿/コメントを表示します。

エクセルマクロVBA「Web連携」
エクセルマクロVBA「Web連携」Microsoft Internet ControlsならではのWebコンテンツの取得

田中 宏明さんの投稿

(投稿ID: 3987)

IEを使わないという選択がベターだとは思いますが、ついIEを使ってしまう私のIE表示待ち時間処理をご紹介させていただきます。
（講座範疇外のため添削不要です。）
Public Sub Myloop(ByRef ie As Object)
    'IE表示完了の待ち合わせ 2018/6/30
    Dim IEretry   As Boolean: IEretry = False
    Dim RepeatSec As Single:  RepeatSec = Timer

On Error GoTo INVALID

    Do While ie.Busy = True Or ie.readyState < 4 'READYSTATE_COMPLETE
        DoEvents
'        Sleep 200  '200ms停止

        If (Timer - RepeatSec) > 80 Then
            Debug.Print ie.readyState
            MsgBox "サーバーが応答していません。インターネット接続をご確認後、再度実行してください。"
            ie.Quit
            End
        ElseIf (Timer - RepeatSec) > 40 And IEretry = False Then
            'IEの再読み込みは１回限りとする
            IEretry = True
            ie.Refresh
        End If
    Loop

    Do While ie.document.readyState <> "complete"
        DoEvents
'        Sleep 200  '200ms停止
        
        If (Timer - RepeatSec) > 100 Then
            Debug.Print ie.document.readyState
            ie.Quit
            MsgBox "ドキュメントを取得できません。インターネット接続をご確認後、再度実行してください。"
            End
        End If
    Loop

    '念のため確認
    DoEvents
    If ie.Busy = True Or ie.readyState < 4 Then
        Call Myloop(ie)  '再帰呼出
    End If
    
    Exit Sub

INVALID:

    Debug.Print "エラー番号:" & Err.Number & vbNewLine & "エラーの種類:" & Err.Description
    '実行時エラー「書き込みできません。」(70)は想定内なので無視。
    'それ以外はエラーを発生させる。
    If Err.Number <> 70 Then
        Err.Raise Err.Number
    Else
        On Error GoTo 0
        MsgBox "IE読み込み時にエラー発生。処理を継続します。"
    End If

End Sub

2018/06/30 21:26