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
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
And the other modified code:
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
Replace thls
With this: