0

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

K.K.
  • 49
  • 8

2 Answers2

1

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
dbmitch
  • 5,361
  • 4
  • 24
  • 38
  • Hi @dbmitch. Thanks for this! It looks like you've rewritten the code. I can't add the kernel declare after my original declare. You wanted me to add this on the very top? As in remove the `Private Sub Credit Union()`? – K.K. Jun 06 '16 at 20:38
  • 1
    the sleepkernel goes above my private declare. Got it. testing now! @dbmitch – K.K. Jun 06 '16 at 20:52
  • Yes - above your sub - at the top of your module. and sorry - didn't really rewrite it - just removed much of the .IsBusy checks. You can leave those if you want. - And you can change the Sleep command to be 1000 (1 sec) or 5000 (5 secs) – dbmitch Jun 06 '16 at 21:00
  • Hi @dbmitch, don't be sorry, you're helping me out! thank you so much. So, I uploaded what my code looks like now in my original question for you to see. I get an automation error right after I get here: `With IE.Document.getelementbyid("MainContent_newDetails") With IE` – K.K. Jun 06 '16 at 21:04
  • Is that what's in your code? Do you have the trailing "With IE"? `With IE.Document.getelementbyid("MainContent_newDetails") With IE` – dbmitch Jun 06 '16 at 21:24
  • It's possible you have a few references to IE open - check Task Manager and kill them if you can... Why did you comment out `IE.Quit Set IE = Nothing` – dbmitch Jun 06 '16 at 21:27
  • Yes @dbmitch. I changed it to `IE.` and got commented `With IE` out and still didn't work. Does `strTargetURL` need a period before it? Thanks again for your responses – K.K. Jun 06 '16 at 21:30
  • and @dbmitch, I got rid of `IE.Quit Set IE=nothing` because I kept getting and `End With` is missing error when I compiled. I still do – K.K. Jun 06 '16 at 21:33
  • How far is it getting? You already have the url hardcoded in .Navigate command - so you don't need that line `strTargetURL = "http://mapping.ncua.gov/ResearchCreditUnion.aspx"` – dbmitch Jun 06 '16 at 21:36
  • Can you copy/paste your code into an email? It sure sounds like you have a "With IE" hanging in the middle of your code - but it doesn't show above – dbmitch Jun 06 '16 at 21:41
  • I see what happened - my copy/paste inserted an extra line at the top Remove the line at the top `With IE.Document.getelementbyid("MainContent_newDetails")` – dbmitch Jun 06 '16 at 21:49
  • Hi @dbmitch! I got the code to work with the help of someone else as well. Thanks a lot. If you want to see the final version, please visit this page, since I know you're interested on knowing how it works! Thanks again: http://stackoverflow.com/questions/37626100/vba-html-data-scrape-guidance/37628175?noredirect=1#comment62816611_37628175 – K.K. Jun 07 '16 at 02:36
  • would you mind helping me link the find button to the updated code? @dbmitch – K.K. Jun 07 '16 at 02:48
  • I tried linking the button to the `sub CreditUnion` method when the "assign macro" popup came, but when I press the button it throws an "Object Required" error @dbmitch – K.K. Jun 07 '16 at 04:28
  • Not sure where the macro popup is coming up. How are you linking the button and where is the sub? If you just right-click on the button and select properties - you can set the event code to call your sub. – dbmitch Jun 07 '16 at 04:35
  • I linked it to the `Sub CreditUnion`. I think we're good. The code works inconsistently. Did you see the new version? @dbmitch – K.K. Jun 07 '16 at 04:38
  • @K.K. Just ha d alook It looks like you went back to using .IsBusy and removed all the code that checks for the element first before proceeding. By inconsistent - do you mean same errors as before? Any time you're going to refer to an element in the doc (IE.document.getelementbyid) you should be looping with DoEvents to make sure it's there first – dbmitch Jun 07 '16 at 04:45
  • So how would I incorporate your sleep method into my updated code @dbmitch? I just didn't understand how or where to incorporate your method into my existing code :( If you could update the updated code I have posted that would be wonderful. – K.K. Jun 07 '16 at 05:04
  • So my other question is, I tried executing with my updated code for new york and dallas, and it outputted just fine - given the large dataset of these two cities. So, what could be causing it to not do it again? Maybe problems with my IE? The webmaster on the other end? Bandwidth? @dbmitch – K.K. Jun 07 '16 at 05:08
  • Can you do the search manually? Can you see an error message in a manual search? Anytime I do massive webscraping I make sure to put long delays between pages and don't run them back to back unless you can change your IP address and / or webbrowser signature – dbmitch Jun 07 '16 at 05:28
  • 1
    Hi @dbmitch, it works now with a sleeper function you suggested! Last night I was having such a hard time connecting to the web, bcs my web provider decided that I have made enough attempts haha. thanks a lot man. I'll keep you posted :) – K.K. Jun 07 '16 at 18:31
0

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
dbmitch
  • 5,361
  • 4
  • 24
  • 38
  • Thank you @dbmitch! I am trying that now. I will give you an update in 4 minutes ha – K.K. Jun 06 '16 at 16:42
  • Hi @dbmitch, it's still loading, after 25 minutes. I want to stop the process, but wanted to update you. Any ideas? Thank you – K.K. Jun 06 '16 at 17:02
  • Hard to know without being there. I'll see if I can patch together something to add a DocumentComplete event. – dbmitch Jun 06 '16 at 17:11
  • Is it possible that there's a popup dialogue box that comes up behind the scenes? Can you see the web browser control? – dbmitch Jun 06 '16 at 17:12
  • I don't see a pop-up @dbmitch. I've gone through this code awhile now, and when I'm debugging it goes from the first url to the next, after it loads the data. The is no action needed on my part – K.K. Jun 06 '16 at 17:21
  • Everything freezes when I try to run the code now @dbmitch :( – K.K. Jun 06 '16 at 17:22
  • I think I just saw an obvious problem - overlooked because I read your comments "wait 5 secs" --- your TimeValue("0"05"00") is 5 minutes not 5 seconds, isn;t it???? – dbmitch Jun 06 '16 at 17:30
  • Is this running in Excel? – dbmitch Jun 06 '16 at 17:39
  • yes, it's 5 minutes because I thought 5 seconds was too low. And yup, in excel 2013 @dbmitch – K.K. Jun 06 '16 at 18:23
  • I still receive the Object Error when I put 10 **seconds** @dbmitch – K.K. Jun 06 '16 at 18:25
  • I think that first `ready state` is the issue. Have you found what's causing it? @dbmitch Thanks in advance! – K.K. Jun 06 '16 at 19:15
  • Yeah - it's the timing for sure. I'll submit suggested code changes in a minute - just testing now – dbmitch Jun 06 '16 at 19:22