internetexplorer.application在VBA中挂在readystate = 1上 [英] internetexplorer.application hangs on readystate=1 in VBA
问题描述
我有一个Excel VBA应用程序,该应用程序使用internetexplorer.application探索应用程序。从15年2月21日开始,此应用程序开始失败,因为readyState永远卡在1上,而不是最终迁移到4。这仅在导航第二个(或更多)链接时发生。第一个URL正常运行。
I have an Excel VBA application which uses internetexplorer.application to explore an application. Starting around 2/21/15, this application started failing on readyState being stuck on 1 forever rather than ultimately migrating to 4. This only occurred when navigating the second (or further) link. The first URL works fine.
出现问题的机器是运行64位Windows 7的Core i5 M520 CPU(4个CPU)。
The machine with the problem is a Core i5 M520 CPU (4 CPU) running 64-bit Windows 7.
另一台运行32位Windows 7的Core 2 Duo T9400的计算机可以毫无问题地执行代码。
Another machine with a Core 2 Duo T9400 running 32-bit Windows 7 executes the code without a problem.
这感觉像是竞争条件,但不确定在64位Windows下是否必须做一些特殊的事情。
This feels like some sort of race condition but I am not sure if I have to do something special under 64-bit windows.
我正在使用Internet Explorer 11,Windows 7和Excel 2003(或2013)。知道出什么问题了吗?
I am using Internet Explorer 11, Windows 7, and Excel 2003 (or 2013). Any idea on what is going wrong?
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
推荐答案
有趣的事情,有时循环 objIE。 readyState<> 4
有效,有时不起作用,并以 readyState = 1
( READYSTATE_LOADING
)挂起即使浏览器窗口显然已完成加载。
"Funny thing", sometimes the loop objIE.readyState <> 4
works, sometimes it doesn't and hangs with readyState = 1
(READYSTATE_LOADING
) even though the browser window is obviously finished loading.
如果我在 navigate <之后添加Sleep / DoEvents循环(> 500ms),则效果最佳/ code>,然后再对IE对象执行其他操作:
It works best if I add a Sleep/DoEvents-loop (>500ms) after navigate
and before doing anything else with the IE-object:
objIE.navigate sURL
For i = 0 To 10
DoEvents
Sleep 100
Next i
objIE.Visible = True
Do While objIE.readyState <> 4
...
希望有帮助!
这篇关于internetexplorer.application在VBA中挂在readystate = 1上的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!