VBA hangs on ie.busy and validation check

Question

I am trying to get data about some football players from the website in order to fill out a personal database. I have included all the code below. This first section is a looper that calls a second function to populate the database. I ran this code in MSAccess to populate the database last summer, and it worked great.

Now I have only a few commands to fill before the program crashes in

While IE.Busy Or IE.ReadyState <> READYSTATE_COMPLETE: DoEvents: Wend 

I searched countless websites about this error and tried to change this code by adding a subfunction to wait for a few seconds or other workarounds. None of them solves the problem. I also tried running this on multiple computers.

The first computer did this through 3 commands (or three calls to the 2nd function). The second slow computer does this through 5 commands. Both end up hanging. Internet Explorer 10 is installed on the first computer, and IE8 is installed on the second.

 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 

Second function:

 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 

Answer 1

In Parse_Team_RawSalaries instead of using the InternetExplorer.Application object, how about using MSXML2.XMLHTTP60 ?

So instead:

 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 

Perhaps try using this (first add the link to "Microsoft XML 6.0" in the VBA editor):

 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 

I usually found that MSXML2.XMLHTTP60 (and WinHttp.WinHttpRequest , for that matter) tend to work better (faster and more reliable) than InternetExplorer.Application .

Answer 2

I found this post very useful when I encountered a similar problem. Here is my solution:

I used

 Dim browser As SHDocVw.InternetExplorer Set browser = New SHDocVw.InternetExplorer 

and

 cTime = Now + TimeValue("00:01:00") Do Until (browser.readyState = 4 And Not browser.Busy) If Now < cTime Then DoEvents Else browser.Quit Set browser = Nothing MsgBox "Error" Exit Sub End If Loop 

Sometimes a page loads, but the code stops in DoEvents and turns on and continues. Using this code, it lasts only for 1 minute, and if the browser is not ready, it exits the browser and exits it.

Answer 3

I know this is an old post, but. I had the same problem with my code for downloading images from a website using Excel VBA automation. Some sites do not allow you to download an image file by link without first opening the link in the browser. However, my code sometimes crashed when objBrowser.visible was set to false with the following code

 Do Until (objBrowser.busy = False And objBrowser.readyState = 4) Application.Wait (Now + TimeValue("0:00:01")) DoEvents 'browser.readyState = 4 Loop 

simple fix - make objBrowser.visible with

  Dim Passes As Integer: Passes = 0 Do Until (objBrowser.busy = False And objBrowser.readyState = 4) Passes = Passes + 1 'count loops Application.Wait (Now + TimeValue("0:00:01")) DoEvents If Passes > 5 Then 'set size browser cannot set it smaller than 400 objBrowser.Width = 400 'set size objBrowser.Height = 400 Label8.Caption = Passes 'display loop count ' position browser "you cannot move it off the screen" ready state wont change objBrowser.Left = UserForm2.Left + UserForm2.Width objBrowser.Top = UserForm2.Top + UserForm2.Height objBrowser.Visible = True DoEvents objBrowser.Visible = False End If Loop 

objBrowser blinks less than a second, but it does its job!