【发布时间】: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