Scraping campsite availability from a webpage using vba with selenium

Question

I wrote some code to extract the information from a table, but it takes an extremely long time.

The table is in the format of a calendar. I need the information on an Excel sheet with column 1 as the day number and column 2 as the accommodation type. On the accommodation type, I only want the “Camp” types and the number of available units to show. I’m sure there will be a better way to loop through the table. Any help will be appreciated.

Here is my code:

Dim driver As New WebDriver, i As Integer, mysheet As Worksheet Dim ele As WebElement Set driver = New EdgeDriver Application.ScreenUpdating = False driver.Start "edge" driver.Get "http://www.sanparks.org/reservations/accommodation/calendar-month/park/26/camp/41/date/2022-07-01" Application.Wait Now + TimeValue("00:00:05") Set mysheet = Sheets("Sheet1") i = 7 eRow = Sheet1.Cells(Rows.Count, 3).End(xlUp).Offset(7, 0).Row For Each ele In driver.FindElementsByClass("day") If ele.FindElementByCss("span").Text <> "" Then mysheet.Cells(i, 2).Value = ele.FindElementByCss("span").Text On Error Resume Next If Mid(ele.FindElementByClass("bold-name").Text, 1, 4) = "Camp" Then 'AccommodationType mysheet.Cells(i, 3).Value = ele.FindElementByClass("bold-name").Text & " " & ele.FindElementByClass("unit-numbers").Text End If On Error GoTo 0 i = i + 1 End If Next ele 

Answer 1

If you aren't locked into using Selenium, you can accomplish something similar to this using a web request. Web Requests should be faster as they don't need to worry about rendering any items on screen, they just return data.

I looked at the web traffic, and noticed this site uses an API to provide the data to the front end. I'm using this API, to return the data as JSON, parsing that, then returning that to an Excel range. This takes about 2 seconds on my machine.

In order to get this to work, you'll need a copy of this --> https://github.com/VBA-tools/VBA-JSON in your project. Follow the directions on the project page to get that setup.

Option Explicit Public Sub ScrapeCampsites() Dim URL As String URL = "https://www.sanparks.org/includes/SANParksApp/API/v1/bookings/accommodation/getAvailabilityAccommodationMonthList.php?resort=10&month=7&year=2022" Dim response As String With CreateObject("MSXML2.XMLHTTP.6.0") .Open "GET", URL, False .send response = .responseText End With 'Include https://github.com/VBA-tools/VBA-JSON into your project Dim Json As Object: Set Json = JsonConverter.ParseJson(response) Dim Accomodations As Object: Set Accomodations = Json("DATA") Dim Accomodation As Variant Dim Availabilities As Variant Dim Availability As Variant Dim Results As Variant ReDim Results(1 To 2, 1 To 50000) Dim i As Long For Each Accomodation In Accomodations If Mid$(Accomodation("accommodationtypedesc"), 1, 4) = "Camp" Then Availabilities = Accomodation("availabilities").Items For Each Availability In Availabilities i = i + 1 Results(1, i) = Availability("availableDate") Results(2, i) = Availability("available") Next End If Next ReDim Preserve Results(1 To 2, i) Dim mySheet As Worksheet Set mySheet = Sheets("Sheet1") mySheet.Range("A1:B1").Value = Array("Date", "Available") mySheet.Range("A2:B" & UBound(Results, 2) + 1) = Application.WorksheetFunction.Transpose(Results) End Sub 

Answer 2

I notice a couple of things:

1. I found reference that says "Webdriver Get will wait until the page has fully loaded before returning the control" so we don't need to wait 5 seconds.

2. FindElementsByClass is an expensive operation. We should never call it multiple times if we can avoid it. I've implemented storing the results in a variable to cut the calls in half per loop.

Try this out and let me know if it's any faster:

Application.ScreenUpdating = False Dim driver As WebDriver Set driver = New EdgeDriver driver.Start "edge" driver.Get "http://www.sanparks.org/reservations/accommodation/calendar-month/park/26/camp/41/date/2022-07-01" Dim mysheet As Worksheet Set mysheet = Sheets("Sheet1") Dim i As Integer i = 7 eRow = mysheet.Cells(Rows.Count, 3).End(xlUp).Offset(7, 0).Row Dim dayClass As Variant dayClass = driver.FindElementsByClass("day") Dim ele As WebElement For Each ele In dayClass Dim spanText As String spanText = ele.FindElementByCss("span").Text If spanText <> "" Then mysheet.Cells(i, 2).Value = spanText Dim boldText As String boldText = ele.FindElementByClass("bold-name").Text On Error Resume Next If Mid(boldText, 1, 4) = "Camp" Then 'AccommodationType mysheet.Cells(i, 3).Value = boldText & " " & ele.FindElementByClass("unit-numbers").Text End If On Error GoTo 0 i = i + 1 End If Next ele ```