【问题标题】:internetexplorer.application hangs on readystate=1 in VBAinternetexplorer.application 在 VBA 中挂起 readystate=1
【发布时间】:2015-03-03 16:17:05
【问题描述】:

我有一个 Excel VBA 应用程序,它使用 internetexplorer.application 来探索应用程序。从 15 年 2 月 21 日左右开始,此应用程序开始失败,因为 readyState 永远卡在 1 而不是最终迁移到 4。这仅在导航第二个(或更多)链接时发生。第一个 URL 工作正常。

有问题的机器是运行 64 位 Windows 7 的 Core i5 M520 CPU(4 CPU)。

另一台装有 Core 2 Duo T9400 并运行 32 位 Windows 7 的机器可以毫无问题地执行代码。

这感觉像是某种竞争条件,但我不确定我是否必须在 64 位窗口下做一些特别的事情。

我使用的是 Internet Explorer 11、Windows 7 和 Excel 2003(或 2013)。知道出了什么问题吗?

Option Explicit

Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Dim objIE As Object
Dim iNodeCount As Long
Dim iLevel As Long
Dim iMaxLevel As Long
Dim iReadyStateLoopCount As Long

'------------------------------------------------------
'
' Main driver of the test case
'
'------------------------------------------------------

Sub Test_IE_Interface()

    Set objIE = CreateObject("InternetExplorer.Application")
    With objIE
      .AddressBar = True
      .StatusBar = True
      .MenuBar = True
      .Toolbar = True
      .Visible = True
    End With

    LoadAPage "http://events.gotsport.com/events/Default.aspx?EventID=44163"

    '  This example generally hangs on the following call

    LoadAPage "http://events.gotsport.com/events/schedule.aspx?EventID=44163&Gender=Boys&Age=18"
    LoadAPage "http://events.gotsport.com/events/schedule.aspx?EventID=44163&Gender=Boys&Age=19"
    LoadAPage "http://events.gotsport.com/events/schedule.aspx?EventID=44163&Gender=Boys&Age=13"
    LoadAPage "http://events.gotsport.com/events/schedule.aspx?EventID=44163&Gender=Boys&Age=14"
    LoadAPage "http://events.gotsport.com/events/schedule.aspx?EventID=44163&Gender=Boys&Age=15"
    LoadAPage "http://events.gotsport.com/events/schedule.aspx?EventID=44163&Gender=Boys&Age=16"
    LoadAPage "http://events.gotsport.com/events/schedule.aspx?EventID=44163&Gender=Boys&Age=17"

    objIE.Quit
End Sub

'--------------------------------------------------------------
'
' This routine loads a web page and then peruses the document
'
'--------------------------------------------------------------

Sub LoadAPage(sURL As String)
    Dim sState As String
    Dim sNewURL As String
    Dim objDoc As Object

    objIE.navigate sURL

    Do While objIE.Busy
        DoEvents
        Sleep 10
        DoEvents
    Loop

    ' >>> Getting stuck in the following loop in the second call <<<
    ' >>> OBJie.readyState is always 1 (READYSTATE_LOADING) <<<

    Do While objIE.readyState <> 4   ' READYSTATE_COMPLETE = 4
        DoEvents
        Sleep 10
        DoEvents
        iReadyStateLoopCount = iReadyStateLoopCount + 1
    Loop

    Set objDoc = objIE.document

    sState = objDoc.readyState
    Do While sState <> "complete"
      DoEvents
      Sleep 10
      sState = objDoc.readyState
    Loop

    If objDoc.URL <> sURL Then
        MsgBox "The new URL was not loaded" & vbCrLf & _
               "URL Requested: " & sURL & vbCrLf & _
               "URL Returned:  " & objDoc.URL
    End If

    iNodeCount = 0
    iLevel = 0
    iMaxLevel = 0

    PeruseTheDocument objDoc

End Sub

'--------------------------------------------------
'
'  This is a dummy routine to examine the document
'
'--------------------------------------------------

Sub PeruseTheDocument(objNode As Object)
    Dim objChild As Object

    iNodeCount = iNodeCount + 1
    iLevel = iLevel + 1

    If iLevel > iMaxLevel Then
        iMaxLevel = iLevel
    End If

    If Not objNode Is Nothing Then
        If Not IsNull(objNode.FirstChild) Then
            Set objChild = objNode.FirstChild
            Do Until IsNull(objChild) Or objChild Is Nothing

                ' Make this go faster by not examining all nodes in the document

                If iLevel < 5 Then
                    PeruseTheDocument objChild
                End If

                If IsNull(objChild.nextSibling) Then
                    Set objChild = Nothing
                Else
                    Set objChild = objChild.nextSibling
                End If
            Loop
        End If
    End If

    iLevel = iLevel - 1
End Sub

【问题讨论】:

    标签: vba internet-explorer excel dom


    【解决方案1】:

    “有趣的事情”,有时循环 objIE.readyState &lt;&gt; 4 有效,有时它不起作用并与 readyState = 1 (READYSTATE_LOADING) 一起挂起,即使浏览器窗口显然已完成加载。

    如果我在navigate 之后和对 IE 对象执行任何其他操作之前添加一个 Sleep/DoEvents-loop (>500ms),效果最好:

    objIE.navigate sURL
    For i = 0 To 10
       DoEvents
       Sleep 100
    Next i
    
    objIE.Visible = True
    
    Do While objIE.readyState <> 4
    ...
    

    希望有帮助!

    【讨论】:

      【解决方案2】:

      我会说下一个作为评论,但没有评论特权。

      (1) 你说它停留在 readystate 1。也许是个愚蠢的问题,但是,你怎么知道的?

      (2) 它有助于在调试时禁用无关的东西。所以注释掉 PeruseTheDocument 调用,然后再试一次(如果它与该过程有关)。

      (3) 不是您的问题的原因,而是:在加载文档时,IE.BUSY 在大多数但不是所有时间为真。它实际上偶尔会在文档完全加载之前变为 FALSE。所以等待 IE.BUSY=FALSE 通常不正确。在您的情况下,这不会有任何区别,因为然后您等待就绪状态 4。但我会删除 BUSY 检查,因为它绝对没有任何用途,而且它是基于对该属性的实际含义。

      HTH

      【讨论】:

      • 感谢cmets:(1)我怎么知道readyState=1?设置断点并使用 VBA 调试器定期检查值。我不确定它总是 1,我确定它永远不会是 4。 (2) 禁用不相关的东西:我不肯定 PeruseTheDocument 是不相关的。但是,结果与注释掉的程序相同。 (3) IE.BUSY在文档加载前变为false:你知道它过早变为false的条件吗?由于我不太了解 IE 的内部原理,所以我只是等待。
      • 对不起,洞穴潜水自动取款机!两天后我回家后会详细查看您的代码。关于。 (3),BUSY=TRUE 表示 IE 正忙于加载或下载此时。FALSE 表示它不忙于加载或下载在此瞬间。但这意味着加载或下载实际上已经完成。人们将 BUSY=-FALSE 误解为“文档已完全加载”。这不是在 akkl 的意思。为错别字等道歉,我在洞穴国家的自动取款机上!
      • 感谢您查看此内容。目标网页不做任何花哨的事情,例如 AJAX 或 onload 事件。我不仅仅是带有一堆图像和一些 CSS 的常规 HTML。
      • 我昨天添加了一条评论,但它似乎已经消失了。是的,请参阅我的新答案(添加为评论太长了)。
      【解决方案3】:

      (天哪,这个界面让事情变得困难!我必须把这个作为答案,因为评论太长了。)

      你的问题不会发生在我身上。

      我无法访问 VBA,因此我将您的代码转换为 VBScript。差异与手头的问题无关。将我的代码复制并粘贴到扩展名为 .VBS 的文件中。双击运行,你会看到每个页面依次准备好。

      请注意,VBScript 变量声明为无类型,从不声明。 “作为对象”。我还将 objIE 设置为过程 Test_IE_Interface() 的本地,然后将其显式传递给 LoadAPage() - 这比使用全局更好(但与手头的问题无关)。

      我的结论是(1)您无意中没有向我们展示实际运行的实际代码;或 (2) 您的网络堆栈或互联网连接有问题。我个人怀疑是(2)。

      试试我的 VBS 代码,看看它是否有效,然后将它转换回 VBA 看看会发生什么。


      Option Explicit
      
      Test_IE_Interface
      WSCRIPT.QUIT
      
      Sub Test_IE_Interface()
      Dim objIE
      
          Set objIE = CreateObject("InternetExplorer.Application")
          With objIE
            .AddressBar = True
            .StatusBar = True
            .MenuBar = True
            .Toolbar = True  ' is actually a numeric property, not boolean.
            .Visible = True
          End With
      
          LoadAPage objIE, "http://events.gotsport.com/events/Default.aspx?EventID=44163"
          LoadAPage objIE, "http://events.gotsport.com/events/schedule.aspx?EventID=44163&Gender=Boys&Age=18"
          LoadAPage objIE, "http://events.gotsport.com/events/schedule.aspx?EventID=44163&Gender=Boys&Age=19"
          LoadAPage objIE, "http://events.gotsport.com/events/schedule.aspx?EventID=44163&Gender=Boys&Age=13"
          LoadAPage objIE, "http://events.gotsport.com/events/schedule.aspx?EventID=44163&Gender=Boys&Age=14"
          LoadAPage objIE, "http://events.gotsport.com/events/schedule.aspx?EventID=44163&Gender=Boys&Age=15"
          LoadAPage objIE, "http://events.gotsport.com/events/schedule.aspx?EventID=44163&Gender=Boys&Age=16"
          LoadAPage objIE, "http://events.gotsport.com/events/schedule.aspx?EventID=44163&Gender=Boys&Age=17"
      
          objIE.Quit
      
      End Sub
      
      Sub LoadAPage (objIE, sURL)
          Dim objDoc
          objIE.navigate sURL
          Do While objIE.readyState <> 4
             WSCRIPT.SLEEP 200  ' VBScript DOEVENTS/SLEEP for 0.2 seconds.
          Loop
          Set objDoc = objIE.document
          MSGBOX "GOT " & SURL & vblf & vblf & left (objDoc.documentelement.outerhtml, 300)
      End Sub
      

      【讨论】:

      • 嗯 - 这并没有解决问题,但我得到了一些见解。我修改了 MSGBOX 以显示收到的 URL:MSGBOX "WANTED" & SURL & vblf & "GOT" & objDoc.URL & vblf & left (objDoc.documentelement.outerhtml, 300)
      • 嗯 - 这并没有解决问题,但我得到了一些见解。我修改了 MSGBOX 以显示收到的 URL --> MSGBOX "WANTED" & SURL & vblf & "GOT" & objDoc.URL & vblf & left (objDoc.documentelement.outerhtml, 300)
      • 哇。我看不到请求 HTTP[S] URL 可以返回 ABOUT:BLANK 页面的任何方式。 ABOUT:BLANK 页面来自 Windows DLL。它是与普通 HTTP[S] 导航完全不同的协议。我建议您跟踪这一点,而不是在获得该页面时重试。您能否发布我的 VBS 脚本的最小(最小)版本,修改为在您的末尾完全如下所示:“脚本请求的最后一个(或唯一)HTTP [S] URL,实际上返回 ABOUT:BLANK 页面” .
      • 已经 2 天了,所以我假设您不再需要任何帮助。
      猜你喜欢
      • 2017-05-24
      • 1970-01-01
      • 2013-07-03
      • 2018-06-17
      • 1970-01-01
      • 2015-08-10
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      相关资源
      最近更新 更多