VBA 挂在 ie.busy 和 readystate 检查上 [英] VBA hanging on ie.busy and readystate check
问题描述
我正在尝试从网站获取一些足球运动员数据以填充私人使用的数据库.我在下面包含了整个代码.第一部分是一个循环程序,它调用第二个函数来填充数据库.去年夏天,我在 MSAccess 中运行了这段代码来填充数据库,效果很好.
I am trying to grab some football player data from a website to fill a privately used database. I've included the entire code below. This first section is a looper that calls the second function to fill a database. I've run this code in MSAccess to fill a database last summer and it worked great.
现在我只需要几个团队在程序挂断之前填补
Now I am only getting a few teams to fill before the program gets hung up at
While IE.Busy Or IE.ReadyState <> READYSTATE_COMPLETE: DoEvents: Wend
我搜索了无数关于此错误的网站,并尝试通过放入子函数等待几秒钟或其他变通方法来更改此代码.这些都没有解决问题.我也试过在多台计算机上运行它.
I've searched countless websites regarding this error and tried changing this code by putting in sub function to wait a period of seconds or other work-arounds. None of those solve the issue. I've also tried running this on multiple computers.
第一台计算机通过了 3 个团队(或第二个函数的三个调用).第二台较慢的计算机使其通过 5 个团队.两者最终都挂了.第一台计算机装有 Internet Explorer 10,第二台计算机装有 IE8.
The first computer made it through 3 teams (or three calls of the 2nd function). The second slower computer makes it through 5 teams. Both eventually hang. The 1st computer has Internet Explorer 10 and the second has IE8.
Sub Parse_NFL_RawSalaries()
Status ("Importing NFL Salary Information.")
Dim mydb As Database
Dim teamdata As DAO.Recordset
Dim i As Integer
Dim j As Double
Set mydb = CurrentDb()
Set teamdata = mydb.OpenRecordset("TEAM")
i = 1
With teamdata
Do Until .EOF
Call Parse_Team_RawSalaries(teamdata![RotoworldTeam])
.MoveNext
i = i + 1
j = i / 32
Status("Importing NFL Salary Information. " & Str(Round(j * 100, 0)) & "% done")
Loop
End With
teamdata.Close ' reset variables
Set teamdata = Nothing
Set mydb = Nothing
Status ("") 'resets the status bar
End Sub
第二个功能:
Function Parse_Team_RawSalaries(Team As String)
Dim mydb As Database
Dim rst As DAO.Recordset
Dim IE As InternetExplorer
Dim HTMLdoc As HTMLDocument
Dim TABLEelements As IHTMLElementCollection
Dim TRelements As IHTMLElementCollection
Dim TDelements As IHTMLElementCollection
Dim TABLEelement As Object
Dim TRelement As Object
Dim TDelement As HTMLTableCell
Dim c As Long
' open the table
Set mydb = CurrentDb()
Set rst = mydb.OpenRecordset("TempSalary")
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = False
IE.navigate "http://www.rotoworld.com/teams/contracts/nfl/" & Team
While IE.Busy Or IE.ReadyState <> READYSTATE_COMPLETE: DoEvents: Wend
Set HTMLdoc = IE.Document
Set TABLEelements = HTMLdoc.getElementsByTagName("Table")
For Each TABLEelement In TABLEelements
If TABLEelement.id = "cp1_tblContracts" Then
Set TRelements = TABLEelement.getElementsByTagName("TR")
For Each TRelement In TRelements
If TRelement.className <> "columnnames" Then
rst.AddNew
rst![Team] = Team
c = 0
Set TDelements = TRelement.getElementsByTagName("TD")
For Each TDelement In TDelements
Select Case c
Case 0
rst![Player] = Trim(TDelement.innerText)
Case 1
rst![position] = Trim(TDelement.innerText)
Case 2
rst![ContractTerms] = Trim(TDelement.innerText)
End Select
c = c + 1
Next TDelement
rst.Update
End If
Next TRelement
End If
Next TABLEelement
' reset variables
rst.Close
Set rst = Nothing
Set mydb = Nothing
IE.Quit
End Function
推荐答案
在Parse_Team_RawSalaries
中,不使用InternetExplorer.Application
对象,如何使用MSXML2.XMLHTTP60
?
In Parse_Team_RawSalaries
, instead of using the InternetExplorer.Application
object, how about using MSXML2.XMLHTTP60
?
所以,而不是这样:
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = False
IE.navigate "http://www.rotoworld.com/teams/contracts/nfl/" & Team
While IE.Busy Or IE.ReadyState <> READYSTATE_COMPLETE: DoEvents: Wend
Set HTMLdoc = IE.Document
也许尝试使用这个(首先在 VBA 编辑器中添加对Microsoft XML 6.0"的引用):
Maybe try using this (add a reference to "Microsoft XML 6.0" in VBA Editor first):
Dim IE As MSXML2.XMLHTTP60
Set IE = New MSXML2.XMLHTTP60
IE.Open "GET", "http://www.rotoworld.com/teams/contracts/nfl/" & Team, False
IE.send
While IE.ReadyState <> 4
DoEvents
Wend
Dim HTMLDoc As MSHTML.HTMLDocument
Dim HTMLBody As MSHTML.htmlBody
Set HTMLDoc = New MSHTML.HTMLDocument
Set HTMLBody = HTMLDoc.body
HTMLBody.innerHTML = IE.responseText
我普遍发现 MSXML2.XMLHTTP60
(和 WinHttp.WinHttpRequest
,就此而言)通常比 InternetExplorer 表现更好(更快、更可靠).应用
.
I've generally found that MSXML2.XMLHTTP60
(and WinHttp.WinHttpRequest
, for that matter) generally perform better (faster and more reliable) than InternetExplorer.Application
.
这篇关于VBA 挂在 ie.busy 和 readystate 检查上的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!