检测到错误 500 时刷新 Internet Explorer

Question

我的代码查看已打开的 Internet Explorer 浏览器，将数据复制到剪贴板，然后将其粘贴到工作表中。网页本身被编码为每 90 秒刷新一次。我的 Excel VBA 代码在计时器上运行，并且工作簿不断使用来自网络的新数据进行自我更新。

程序运行良好，直到网站出现随机服务器故障并抛出 500 Internal Server Error，因此：

1. 我无法再复制到剪贴板，

2. 网页停止刷新。从本质上讲，它会让我的 Excel 程序陷入困境，直到有人手动打开并刷新网页。

我需要一些代码来识别网页何时无法加载并在发生这种情况时自动刷新 IE。

这是我当前的代码：

'**** FIND OPEN IE WINDOW THAT HAS MY DESIRED URL LOADED ****
Set objShell = CreateObject("Shell.Application")
ie_count = objShell.Windows.Count

For x = 0 To (ie_count - 1)
    On Error Resume Next    
    my_url = objShell.Windows(x).document.Location
    my_title = objShell.Windows(x).document.Title

    If my_url Like "http://myurl.com" & "*" Then 
        Set ie = objShell.Windows(x)
    End If
Next x


'**** COPY TABLE FROM WEB, PASTE IN SHEET ****

Dim doc As MSHTML.HTMLDocument
Dim tables As MSHTML.IHTMLElementCollection
Dim table As MSHTML.HTMLTable
Dim clipboard As MSForms.DataObject

With ie
    .Visible = False
    While .Busy Or .readyState <> READYSTATE_COMPLETE
        DoEvents
    Wend

    Set doc = .document
    Set tables = doc.getElementsByTagName("table")
    Set table = tables(0)
    Set clipboard = New MSForms.DataObject
    clipboard.SetText table.outerHTML
    Application.Wait (Now + TimeValue("0:00:01"))
    clipboard.PutInClipboard
    Application.Wait (Now + TimeValue("0:00:01"))
    sh3.Paste
    Application.CutCopyMode = False
End With

Answer 1

如果它每次都在特定的代码行上停止执行，请将其放在该行之前：

On Error Resume Next
TryAgain:

...就在那一行之后：

On Error GoTo 0
If Err Then
   Debug.Print "Error #" & Err & ": " & Err.Description
   ie.Refresh
   Do: DoEvents: Loop Until ie.ReadyState = 4
   Err.Clear
   GoTo TryAgain
End If