VBA hanging on ie.busy and readystate check

Question

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.

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

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

check in system application manager if `IE.Quit` manages to close all IE application efficiently. You could try to open only one IE app and pass it as parameter to your function. To my experiences opening IE is time-consuming process... — Kazimierz Jawor, Jul 05 '13 at 05:22

score 15 · Accepted Answer · answered Jul 05 '13 at 05:25

15

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

So, instead of this:

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

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

I've generally found that MSXML2.XMLHTTP60 (and WinHttp.WinHttpRequest, for that matter) generally perform better (faster and more reliable) than InternetExplorer.Application.

answered Jul 05 '13 at 05:25

wlgreg

451
4
8

Incredible - totally works again!! Thank you soooo much. This has saved me many, many hours. Just a quick last question - what do I do with the IE.Quit at the end of the 2nd function? It had an error when I ran and I wondered if I need some comparable? – Doubledown Jul 05 '13 at 12:17
1

You can change 'IE.Quit' to 'Set IE = Nothing'. Glad it helped! – wlgreg Jul 05 '13 at 15:22
because some web page puts lot of important content in javascript to prevent people scrubbing. Does MSXML2.XMLHTTP60 supports running js? – chantisnake Jul 10 '16 at 15:33
You also need to add the reference "Microsoft HTML Object Library" [MSHTML.TLB] – dontbyteme Oct 18 '17 at 06:57

score 3 · Answer 2 · answered Mar 01 '14 at 11:25

I've found this post very helpful when I encountered similiar 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 page is loaded but code stops on DoEvents and goes on and on and on. Using this code it goes on only for 1 minute and if browser is not ready it quits the browser and exits sub.

score 1 · Answer 3 · answered Nov 09 '18 at 03:10

I know this is a old post but. I have had the same problem with my code for downloading web site pictures using Excel VBA automation. Some sites wont let you download a image file using a link without first opening the link in a browser. However my code was getting hung up sometimes with when the objBrowser.visible was set to false with the folowing code

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

the simple fix was to make the objBrowser.visible I fixed it 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 only flashes for less than a second but it gets the job done!

VBA hanging on ie.busy and readystate check

3 Answers3

Linked