Question

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

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

我无法再复制到剪贴板，
网页停止刷新。基本上它会让我的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

检测到错误500时刷新Internet Explorer

1 个答案: