internetexplorer.application在VBA中挂在readystate = 1上

时间:2015-03-03 16:17:05

标签: vba internet-explorer excel-vba dom excel

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

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

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

这感觉就像某种竞争条件,但我不确定我是否必须在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

3 个答案:

答案 0 :(得分:1)

“有趣的事情”,有时循环objIE.readyState <> 4有效,有时它不会和readyState = 1READYSTATE_LOADING)挂起,即使浏览器窗口显然已完成加载。

如果我在navigate之后和IE对象做任何其他事情之前添加Sleep / DoEvents循环(> 500ms),效果最好:

objIE.navigate sURL
For i = 0 To 10
   DoEvents
   Sleep 100
Next i

objIE.Visible = True

Do While objIE.readyState <> 4
...

希望有所帮助!

答案 1 :(得分:0)

我说所有下一个都是评论,但没有评论特权。

(1)你说它被困在状态1.也许是一个愚蠢的问题,但是,你怎么知道呢?

(2)调试时有助于禁用无关紧要的事情。因此,请注释掉PeruseTheDocument调用,然后再试一次(关于它与该程序有关的可能性)。

(3)不是问题的原因,但是:在加载文档时,IE.BUSY对于大多数而不是所有来说都是正确的。在文档完全加载之前,它实际上偶尔会变为。因此等待IE.BUSY = FALSE通常不正确。在你的情况下,没有任何区别,因为然后你等待准备状态4.但是我删除了忙碌检查,因为它完全没有任何目的,它&#&#&# 39;基于对该财产实际意义的误解。

HTH

答案 2 :(得分:0)

(Geez这个界面让事情变得困难!!我必须回答这个问题,因为评论太长了。)

我的问题不会发生。

我无权访问VBA,因此我将您的代码转换为VBScript。差异与手头的问题无关。复制&amp;将我的代码粘贴到扩展名为.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