HTML scraping in VBA - all values in multipage list - html

Question

I am trying to gather all of the property data from this website:
http://taxsales.lgbs.com/
There are currently 7,000+ properties, but on any given view of the page I can only see 15 - 20 depending on screen resolution.
I have figured out, roughly, how to search through the HTML for the property names and details. Because the initial search has a warning screen, I'm using the following code to "click" the "Agree" button to see the subsequent search page. You can also see that I don't know how to find only the property details, and am instead taking (basically) all of the HTML from the whole site and sifting through it later in excel.
Questions:
1) Is there any way to see data for all of the properties at once? -or- How can I "page" through each portion of the results to eventually collect all of them?
2) How can I collect only the data for property address, sale date, sale type, etc.?
Sub HTML_scrape()
Dim IE As Object
Dim objElement As Object
Dim objCollection As Object
Dim objCollection2 As Object
Dim r As Integer
Dim v As Object
' Create InternetExplorer Object
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True
' Using the URL with "full" map
IE.navigate "http://taxsales.lgbs.com/map?lat=39.576604&lon=-96.72178200000002&zoom=4&offset=0&ordering=sale_date,address_full,uid&sale_type=SALE,RESALE,STRUCK%20OFF,FUTURE%20SALE&in_bbox=-137.2217809271164,15.247775193567845,-56.221783072883625,57.63696077532424"
' Wait while IE loading...
Do While (IE.Busy Or IE.READYSTATE <> 4)
Application.Wait DateAdd("s", 2, Now)
Loop
' Click the Agree Button
Set objCollection = IE.document.getElementsByClassName("btn btn-primary")
objCollection(0).Click
Do While (IE.Busy Or IE.READYSTATE <> 4)
Application.Wait DateAdd("s", 2, Now)
Loop
' Find all tags and collect the associated data
' This should only find the relevant property data, but I can not
' figure out how to only take the information within a
' <a class="ng-binding" ng-click="listing.addressClick()"> tag
Set objCollection2 = IE.document.getElementsByTagName("*")
r = 1
For Each v In objCollection2
Sheets("Sheet1").Range("A" & r).Value = v.outerHTML
r = r + 1
Next
With Sheets("Sheet1").Columns("A")
Dim DQ As String
DQ = Chr(34)
.Replace What:="#", Replacement:="'"
.Replace What:=DQ, Replacement:="'"
End With
End Sub
Property Sale Date HTML:
<li ng-if="listing.property.sale_date" class="ng-binding ng-scope"><label>Sale Date:</label> 4/5/18 9:00 AM</li>
Property Address HTML:
<a ng-click="listing.addressClick()" class="ng-binding"> 02863 Stouton St, Philadelphia PA 19134-3515 </a>
Next Button HTML:
Next

Answer 1

Here's a hacky approach to use web requests (xhr) instead. Looking at the requests for the page it looks like it returns a JSON object. I'm parsing this JSON object and dumping it to a range on the first sheet. Here's some code that should get you started.
'You'll need the following references:
'MSXML v6.0
'Microsoft Scripting Runtime
'JSON project from: https://github.com/VBA-tools/VBA-JSON
Public Sub Scraper()
Dim webrequest As MSXML2.XMLHTTP60
Dim JSON As Object
Dim responses As Object
Dim itemdict As Variant
Dim i As Long
Dim j As Long
Dim k As Long
Dim item As Variant
Dim myarray As Variant: ReDim myarray(0 To 20, 0 To 5000)
Dim url As String: url = "http://taxsales.lgbs.com/api/property_sales/?in_bbox=-139.04111793750002%2C7.97834134877145%2C-54.40244606250002%2C61.39968867373271&offset=10&ordering=sale_date%2Caddress_full%2Cuid&sale_type=SALE%2CRESALE%2CSTRUCK+OFF%2CFUTURE+SALE"
For i = 0 To 10 'Do a loop to get SOME of the data, probably need a different loop here
With New MSXML2.XMLHTTP60
.Open "GET", url
.setRequestHeader "accept", "application/json, text/plain, */*"
.send
'Parse the response into a JSON dict
Set JSON = JsonConverter.ParseJson(.responseText)
url = JSON("next") ' the next URl to send a GET request
Set responses = JSON("results") 'Get the results Dict
On Error Resume Next ' getting an error, just ignoring for now
For Each itemdict In responses
j = 0
'add headers
If k = 0 Then
For Each item In itemdict
myarray(j, k) = item
j = j + 1
Next
End If
'add values
For Each item In itemdict
myarray(j, k) = itemdict(item)
j = j + 1
Next
k = k + 1
Next
On Error GoTo 0
End With
Next
ReDim Preserve myarray(0 To 20, 0 To k - 1)
ThisWorkbook.Sheets(1).Range("A1:T" & k - 1).Value = TransposeArray(myarray)
End Sub
'using this function as worksheetfunction.transpose causing issues
Public Function TransposeArray(myarray As Variant) As Variant
Dim X As Long
Dim Y As Long
Dim Xupper As Long
Dim Yupper As Long
Dim tempArray As Variant
Xupper = UBound(myarray, 2)
Yupper = UBound(myarray, 1)
ReDim tempArray(Xupper, Yupper)
For X = 0 To Xupper
For Y = 0 To Yupper
tempArray(X, Y) = myarray(Y, X)
Next
Next
TransposeArray = tempArray
End Function
Output: