VBA Application.Wait Object Error

2019-09-16 12:39发布

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

2条回答
劫难
2楼-- · 2019-09-16 13:11

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
查看更多
爷的心禁止访问
3楼-- · 2019-09-16 13:12

I think you're going in the right direction. The problem is that the document hasn't completely rendered. The ideal solution should be to add a global boolean variable "docComplete" that gets set to false before you navigate and true once that event has fired and the destination URL matches your navigate URL.

But this simpler solution might work for now

Before this line

With IE.document.getelementbyid("MainContent_newDetails")

Replace thls

'wait 5 sec. for screen refresh
beginTime = Now
Application.Wait beginTime + TimeValue("0:05:00")

With this:

Do While IE.ReadyState = 4: beginTime = Now: Application.Wait beginTime + TimeValue("0:00:05"): Loop
Do While IE.ReadyState <> 4: beginTime = Now: Application.Wait beginTime + TimeValue("0:00:05"): Loop
查看更多
登录 后发表回答