K.K. K.K. - 5 months ago 26
HTML Question

VBA Application.Wait Object Error

I've tried running this code and it gets an object error, given that I have inputted anywhere between 10 seconds to 5 minutes of wait time for the loops to start. When I'm debugging, I get the results outputted just fine, but I have to go through the cases manually to make it work -- which takes awhile for a large data set.

I tried with a small data, by having the city be "alaska." Is there anyway to make this code work without me manually debugging it? Because I honestly don't know why it's not working. Thanks so much in advance.

Private Sub CreditUnion()

Dim IE As Object, TableResults As Object, webRow As Object, charterInfo As Variant, page As Long, r As Long
Dim beginTime As Date, i As Long

Set IE = CreateObject("internetexplorer.application")
IE.navigate "http://mapping.ncua.gov/ResearchCreditUnion.aspx"
IE.Visible = False

Do While IE.Busy
DoEvents
Loop

'input city name into form
IE.document.getelementbyid("MainContent_txtCity").Value = Worksheets(1).Range("B1").Value
'click find button
IE.document.getelementbyid("MainContent_btnFind").Click


Do
DoEvents

'wait 5 sec. for screen refresh
beginTime = Now
Application.Wait (Now + TimeValue("00:05:00"))
With IE.document.getelementbyid("MainContent_grid")
For r = 1 To .Rows.Length - 1
If Not IsArray(charterInfo) Then
ReDim charterInfo(5, 0) As Variant
Else
ReDim Preserve charterInfo(5, UBound(charterInfo, 2) + 1) As Variant
End If

charterInfo(0, UBound(charterInfo, 2)) = .Rows(r).Cells(0).innertext
Next r
End With

'check if final page, if not click "next page"
page = IE.document.getelementbyid("MainContent_pager_to").innertext

If page < IE.document.getelementbyid("MainContent_pager_total").innertext Then IE.document.getelementbyid("MainContent_pageNext").Click
Loop Until page = IE.document.getelementbyid("MainContent_pager_total").innertext

For r = 0 To UBound(charterInfo, 2)
IE.navigate "http://mapping.ncua.gov/SingleResult.aspx?ID=" & charterInfo(0, r)
Do While IE.Busy
DoEvents
Loop
'wait 5 sec. for screen refresh
beginTime = Now
Application.Wait beginTime + TimeValue("0:05:00")

With IE.document.getelementbyid("MainContent_newDetails")
For i = 0 To .Rows.Length - 1
DoEvents
Select Case .Rows(i).Cells(0).innertext
Case "Credit Union Name:"
charterInfo(1, r) = .Rows(i).Cells(1).innertext
Case "Region:"
charterInfo(2, r) = .Rows(i).Cells(1).innertext
Case "Credit Union Status:"
charterInfo(3, r) = .Rows(i).Cells(1).innertext
Case "Assets:"
charterInfo(4, r) = Replace(Replace(.Rows(i).Cells(1).innertext, ",", ""), "$", "")
Case "Number of Members:"
charterInfo(5, r) = Replace(.Rows(i).Cells(1).innertext, ",", "")
End Select
Next i
End With
Next r


IE.Quit
Set IE = Nothing

'post result on Excel cell
Worksheets(1).Range("A5").Resize(UBound(charterInfo, 2) + 1, UBound(charterInfo, 1) + 1).Value = Application.Transpose(charterInfo)
End Sub


Updated Code w/ Sleeper API (still not working)




Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Sub CreditUnion()

Dim IE As Object, TableResults As Object, webRow As Object, charterInfo As Variant, page As Long, r As Long
Dim beginTime As Date, i As Long

Set IE = CreateObject("internetexplorer.application")

With IE.Document.getelementbyid("MainContent_newDetails")
With IE
strTargetURL = "http://mapping.ncua.gov/ResearchCreditUnion.aspx"
.Navigate "http://mapping.ncua.gov/ResearchCreditUnion.aspx"
.Visible = False

While IsNull(.Document.getelementbyid("MainContent_txtCity"))
DoEvents
Sleep 500
Wend

'input city name into form
.Document.getelementbyid("MainContent_txtCity").Value = Worksheets(1).Range("B1").Value
DoEvents
Sleep 500

'click find button
.Document.getelementbyid("MainContent_btnFind").Click
End With


Do
DoEvents

While IsNull(IE.Document.getelementbyid("MainContent_grid"))
DoEvents
Sleep 1000
Wend

For r = 1 To IE.Document.getelementbyid("MainContent_grid").Rows.Length - 1
If Not IsArray(charterInfo) Then
ReDim charterInfo(5, 0) As Variant
Else
ReDim Preserve charterInfo(5, UBound(charterInfo, 2) + 1) As Variant
End If

charterInfo(0, UBound(charterInfo, 2)) = IE.Document.getelementbyid("MainContent_grid").Rows(r).Cells(0).innertext
Next r

'check if final page, if not click "next page"
page = IE.Document.getelementbyid("MainContent_pager_to").innertext

If page < IE.Document.getelementbyid("MainContent_pager_total").innertext Then
IE.Document.getelementbyid("MainContent_pageNext").Click

Do While IE.Busy
DoEvents
Sleep 500
Loop

While IsNull(IE.Document.getelementbyid("MainContent_pager_total"))
DoEvents
Sleep 1000
Wend

End If
Loop Until page = IE.Document.getelementbyid("MainContent_pager_total").innertext

For r = 0 To UBound(charterInfo, 2)

IE.Navigate "http://mapping.ncua.gov/SingleResult.aspx?ID=" & charterInfo(0, r)
Do While IE.Busy
DoEvents
Loop

While IsNull(IE.Document.getelementbyid("MainContent_newDetails"))
DoEvents
Sleep 1000
Wend

With IE.Document.getelementbyid("MainContent_newDetails")
For i = 0 To .Rows.Length - 1
DoEvents
Select Case .Rows(i).Cells(0).innertext
Case "Credit Union Name:"
charterInfo(1, r) = .Rows(i).Cells(1).innertext
Case "Region:"
charterInfo(2, r) = .Rows(i).Cells(1).innertext
Case "Credit Union Status:"
charterInfo(3, r) = .Rows(i).Cells(1).innertext
Case "Assets:"
charterInfo(4, r) = Replace(Replace(.Rows(i).Cells(1).innertext, ",", ""), "$", "")
Case "Number of Members:"
charterInfo(5, r) = Replace(.Rows(i).Cells(1).innertext, ",", "")
End Select
Next i

End With
Next r

'IE.Quit
'Set IE = Nothing

'post result on Excel cell
Worksheets(1).Range("A5").Resize(UBound(charterInfo, 2) + 1, UBound(charterInfo, 1) + 1).Value = Application.Transpose(charterInfo)
End With

End Sub


UPDATED CODE 6/6/2016 (credit to @pcw & @dbmitch)




Sub CreditUnion()

Dim IE As Object, TableResults As Object, webRow As Object, charterInfo As Variant, page As Long, pageTotal As Long, r As Long
Dim beginTime As Date, i As Long

Set IE = CreateObject("internetexplorer.application")
IE.navigate "http://mapping.ncua.gov/ResearchCreditUnion.aspx"
IE.Visible = False

Do While IE.Busy
DoEvents
Loop

'input city name into form
IE.document.getelementbyid("MainContent_txtCity").Value = Worksheets(1).Range("B1").Value
'click find button
IE.document.getelementbyid("MainContent_btnFind").Click
beginTime = Now
Application.Wait (Now + TimeValue("00:00:05"))
'total pages
pageTotal = IE.document.getelementbyid("MainContent_pager_total").innertext
page = 0

Do Until page = pageTotal
DoEvents
page = IE.document.getelementbyid("MainContent_pager_to").innertext
With IE.document.getelementbyid("MainContent_grid")
For r = 1 To .Rows.Length - 1
If Not IsArray(charterInfo) Then
ReDim charterInfo(5, 0) As Variant
Else
ReDim Preserve charterInfo(5, UBound(charterInfo, 2) + 1) As Variant
End If

charterInfo(0, UBound(charterInfo, 2)) = .Rows(r).Cells(0).innertext
Next r
End With

If page < pageTotal Then
IE.document.getelementbyid("MainContent_pageNext").Click
beginTime = Now
Application.Wait (Now + TimeValue("00:00:05"))
End If
Loop

For r = 0 To UBound(charterInfo, 2)
IE.navigate "http://mapping.ncua.gov/SingleResult.aspx?ID=" & charterInfo(0, r)
Do While IE.Busy
DoEvents
Loop
'wait 5 sec. for screen refresh
beginTime = Now
Application.Wait beginTime + TimeValue("0:00:05")

With IE.document.getelementbyid("MainContent_newDetails")
For i = 0 To .Rows.Length - 1
DoEvents
Select Case .Rows(i).Cells(0).innertext
Case "Credit Union Name:"
charterInfo(1, r) = .Rows(i).Cells(1).innertext
Case "Region:"
charterInfo(2, r) = .Rows(i).Cells(1).innertext
Case "Credit Union Status:"
charterInfo(3, r) = .Rows(i).Cells(1).innertext
Case "Assets:"
charterInfo(4, r) = Replace(Replace(.Rows(i).Cells(1).innertext, ",", ""), "$", "")
Case "Number of Members:"
charterInfo(5, r) = Replace(.Rows(i).Cells(1).innertext, ",", "")
End Select
Next i
End With
Next r


IE.Quit
Set IE = Nothing

'post result on Excel cell
Worksheets(1).Range("A5").Resize(UBound(charterInfo, 2) + 1, UBound(charterInfo, 1) + 1).Value = Application.Transpose(charterInfo)
End Sub


Help with creating a dynamic button to press to start the search press
Help w/ button creating

Answer

Okay - I was going to edit last answer, but the waits and readystates and busy checks were just not going to work. I did check into adding a WithEvents for checking actual document completion, but that wouldn't work for your case. The page url never changes with the button clicks. So try this instead

I just make sure the elements you're trying to load are actually there before trying to use them.

Warning - this could lead to an infinite loop if the elements never appear. Ideally you'd add a MAXIMUM_TIME constant and a loop for number of seconds that has elapsed.

I also changed your Application.Wait code to use the Sleep WIn32 API - since I wasn't sure what application you were using. You can add this declare to the top of your code

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

And the other modified code:

    With IE
        strTargetURL = "http://mapping.ncua.gov/ResearchCreditUnion.aspx"
        .Navigate "http://mapping.ncua.gov/ResearchCreditUnion.aspx"
        .Visible = False

        While IsNull(.Document.getelementbyid("MainContent_txtCity"))
            DoEvents
            Sleep 500
        Wend

        'input city name into form
        .Document.getelementbyid("MainContent_txtCity").Value = Worksheets(1).Range("B1").Value
        DoEvents
        Sleep 500

        'click find button
        .Document.getelementbyid("MainContent_btnFind").Click
    End With


    Do
        DoEvents

        While IsNull(IE.Document.getelementbyid("MainContent_grid"))
            DoEvents
            Sleep 1000
        Wend

        For r = 1 To IE.Document.getelementbyid("MainContent_grid").Rows.Length - 1
            If Not IsArray(charterInfo) Then
                ReDim charterInfo(5, 0) As Variant
            Else
                ReDim Preserve charterInfo(5, UBound(charterInfo, 2) + 1) As Variant
            End If

            charterInfo(0, UBound(charterInfo, 2)) = IE.Document.getelementbyid("MainContent_grid").Rows(r).Cells(0).innertext
        Next r

        'check if final page, if not click "next page"
        page = IE.Document.getelementbyid("MainContent_pager_to").innertext

        If page < IE.Document.getelementbyid("MainContent_pager_total").innertext Then
            IE.Document.getelementbyid("MainContent_pageNext").Click

            Do While IE.Busy
                DoEvents
                Sleep 500
            Loop

            While IsNull(IE.Document.getelementbyid("MainContent_pager_total"))
                DoEvents
                Sleep 1000
            Wend

        End If
    Loop Until page = IE.Document.getelementbyid("MainContent_pager_total").innertext

    For r = 0 To UBound(charterInfo, 2)

        IE.Navigate "http://mapping.ncua.gov/SingleResult.aspx?ID=" & charterInfo(0, r)
        Do While IE.Busy
            DoEvents
        Loop

        While IsNull(IE.Document.getelementbyid("MainContent_newDetails"))
            DoEvents
            Sleep 1000
        Wend

        With IE.Document.getelementbyid("MainContent_newDetails")
            For i = 0 To .Rows.Length - 1
                DoEvents
                Select Case .Rows(i).Cells(0).innertext
                Case "Credit Union Name:"
                    charterInfo(1, r) = .Rows(i).Cells(1).innertext
                Case "Region:"
                    charterInfo(2, r) = .Rows(i).Cells(1).innertext
                Case "Credit Union Status:"
                    charterInfo(3, r) = .Rows(i).Cells(1).innertext
                Case "Assets:"
                    charterInfo(4, r) = Replace(Replace(.Rows(i).Cells(1).innertext, ",", ""), "$", "")
                Case "Number of Members:"
                    charterInfo(5, r) = Replace(.Rows(i).Cells(1).innertext, ",", "")
                End Select
            Next i

        End With
    Next r
Comments