VBA: GetElementbyClassName

[jamescooper]

Hello,

Cannot quite work out what I am doing wrong to pull the initial price from the website listed below. It should be £585 but it is falling down on the code:

price = html.getElementsByID("_tyxjp1").innerText

Any help is greatly appreciated.

Many thanks.

Sub Get_Web_Data()

Dim request As Object
Dim response As String
Dim html As New HTMLDocument
Dim website As String
Dim price As Variant

website = "https://www.airbnb.co.uk/s/Cardiff-city-centre--Cardiff/homes?adults=4&place_id=ChIJE5-LOrccbkgRzfLvM7ow5xU&checkin=2022-06-18&checkout=2022-06-19&tab_id=home_tab&refinement_paths%5B%5D=%2Fhomes&query=Cardiff%20city%20centre%2C%20Cardiff&flexible_trip_lengths%5B%5D=one_week&date_picker_type=calendar&source=structured_search_input_header&search_type=filter_change&ne_lat=51.49207564654211&ne_lng=-3.1483986320495774&sw_lat=51.468395512898894&sw_lng=-3.2042314949035813&zoom=14&search_by_map=true&room_types%5B%5D=Entire%20home%2Fapt"

Set request = CreateObject("MSXML2.XMLHTTP")

request.Open "GET", website, False

'fresh data
'request.SetRequestHeader "If-Modified-Since", "Sun, 22 May 2022 00:00:00 GMT"

request.send

response = StrConv(request.responseBody, vbUnicode)

html.body.innerHTML = response

price = html.getElementsByID("_tyxjp1").innerText

MsgBox price

End Sub

 

[Anthony47]

getElementsByID is wrong; getElementByID is correct

Retry...

 

[jamescooper]

getElementsByID is wrong; getElementByID is correct

Retry...

Still failing on this line:

price = html.getElementByID("_tyxjp1").innerText

Run-time error 91.

 

[Anthony47]

That site don't have any ID="_tyxjp1"
Also, it is strictly "script based", an XML request will not return any useful information.
And finally, it is not compatible with I.E., that could have been managed using Microsoft MSHTML.tlb library

The only way I am able to suggest is via the "Selenium environment" that should be installed on your computer.
If you are interested, you'll find the instruction on how installing it in this message: extract data from web to inside sheet without open website &refersh

After the iinstallation you should be able to open the site using Chrome, access the elements related to the available apartments and scrape some basic information using the following code:

Sub ABBInfo()
Dim wPage As Object
Dim myUrl As String, I As Long
Dim NextR As Long
Dim pColl As Object, aptColl As Object
'
myUrl = "https://www.airbnb.co.uk/s/Cardiff-city-centre--Cardiff/homes?adults=4&place_id=ChIJE5-LOrccbkgRzfLvM7ow5xU&checkin=2022-06-18&checkout=2022-06-19&tab_id=home_tab&refinement_paths%5B%5D=%2Fhomes&query=Cardiff%20city%20centre%2C%20Cardiff&flexible_trip_lengths%5B%5D=one_week&date_picker_type=calendar&source=structured_search_input_header&search_type=filter_change&ne_lat=51.49207564654211&ne_lng=-3.1483986320495774&sw_lat=51.468395512898894&sw_lng=-3.2042314949035813&zoom=14&search_by_map=true&room_types%5B%5D=Entire%20home%2Fapt"
'
'Crea Driver:
Set wPage = CreateObject("Selenium.CHRomedriver")
wPage.Get myUrl
Sheets("Main").Select
For I = 1 To 10
    Set aptColl = wPage.FindElementsByClass("g1tup9az")
    wPage.Wait 400
    If aptColl.Count > 0 Then Exit For
Next I
Debug.Print aptColl.Count, I
Set aptColl = wPage.FindElementsByClass("g1tup9az")
Range("A1:C1").Value = Array("Description", "Overview", "Price")
For I = 1 To aptColl.Count
    NextR = Cells(Rows.Count, 1).End(xlUp).Row + 1
    Set pColl = aptColl(I).FindElementsByTag("div")
    Cells(NextR, 1) = pColl(1).Text
    Cells(NextR, 2) = Replace(pColl(2).Text, Chr(10), " ", , , vbTextCompare)
    Cells(NextR, 3) = Replace(pColl(7).Text, Chr(10), " ", , , vbTextCompare)
Next I
'
Beep
SQuit:
wPage.Quit
MsgBox ("Completed, " & I - 1)
Set wPage = Nothing
End Sub

Your output will be like the attached image

 

[jamescooper]

Thanks for your help with the code, it works well - great instructions.

Some slight modifications if I could, I'd like to be able to pull

- the number of stays at the top of the page
- for it to loop through each of the pages, it appears the website only pulls 20 results per page

Any chance of how to do this please?

Many thanks.

 

[Anthony47]

The following version reads the several blocks of results:

Dim wPage As Object
Dim myUrl As String, I As Long
Dim NextR As Long, NextP As Long
Dim pColl As Object, aptColl As Object
'
myUrl = "https://www.airbnb.co.uk/s/Cardiff-city-centre--Cardiff/homes?adults=4&place_id=ChIJE5-LOrccbkgRzfLvM7ow5xU&checkin=2022-06-18&checkout=2022-06-19&tab_id=home_tab&refinement_paths%5B%5D=%2Fhomes&query=Cardiff%20city%20centre%2C%20Cardiff&flexible_trip_lengths%5B%5D=one_week&date_picker_type=calendar&source=structured_search_input_header&search_type=filter_change&ne_lat=51.49207564654211&ne_lng=-3.1483986320495774&sw_lat=51.468395512898894&sw_lng=-3.2042314949035813&zoom=14&search_by_map=true&room_types%5B%5D=Entire%20home%2Fapt"
'
'Crea Driver:
Set wPage = CreateObject("Selenium.CHRomedriver")
wPage.Get myUrl
Sheets("Main").Select
Stop
ReLoop:
For I = 1 To 10
    Set aptColl = wPage.FindElementsByClass("g1tup9az")
    wPage.Wait 400
    If aptColl.Count > 0 Then Exit For
Next I
NextP = NextP + 1
Debug.Print "Apt found=" & aptColl.Count, "I=" & I, "Page=" & NextP
Set aptColl = wPage.FindElementsByClass("g1tup9az")
Range("A1:C1").Value = Array("Description", "Overview", "Price")
For I = 1 To aptColl.Count
    NextR = Cells(Rows.Count, 1).End(xlUp).Row + 1
    Set pColl = aptColl(I).FindElementsByTag("div")
    Cells(NextR, 1) = pColl(1).Text
    Cells(NextR, 2) = Replace(pColl(2).Text, Chr(10), " ", , , vbTextCompare)
    Cells(NextR, 3) = Replace(pColl(7).Text, Chr(10), " ", , , vbTextCompare)
Next I
'
'Accept cookies
Set aptColl = wPage.FindElementsByClass("_148dgdpk")
If aptColl.Count = 1 Then aptColl(1).Click: wPage.Wait 100
'search Next & click
Set aptColl = wPage.FindElementsByClass("_jro6t0")
Set pColl = aptColl(1).FindElementsByTag("a")
For I = 1 To pColl.Count
    If pColl(I).Attribute("aria-label") = "Next" Then
        pColl(I).Click
        Debug.Print "Next 20"
        wPage.Wait 990
        GoTo ReLoop
    End If
Next I
Beep
SQuit:
wPage.Quit
MsgBox ("Completed, " & NextP & " pages")
Set wPage = Nothing
End Sub

Furthermore, the macro stops at the beginning to allow the user to change manually the search parametres and excecute the search; at that point you need to return to the vba and press the "Continue" button (or press F5) to continue the macro and extract the information.

Surely some more sophisticated automation could be developed, but you need to settle for this

 

[jamescooper]

That is brilliant, it works great - can I ask why it stops as I wasn't prompted to manually change any search parameters?

Also if I was to do a loop now through several URLs - I'd need to modify this...

myUrl = "https://www.airbnb.co.uk/s/Cardiff-city-centre--Cardiff/homes?adults=4&place_id=ChIJE5-LOrccbkgRzfLvM7ow5xU&checkin=2022-06-18&checkout=2022-06-19&tab_id=home_tab&refinement_paths%5B%5D=%2Fhomes&query=Cardiff%20city%20centre%2C%20Cardiff&flexible_trip_lengths%5B%5D=one_week&date_picker_type=calendar&source=structured_search_input_header&search_type=filter_change&ne_lat=51.49207564654211&ne_lng=-3.1483986320495774&sw_lat=51.468395512898894&sw_lng=-3.2042314949035813&zoom=14&search_by_map=true&room_types%5B%5D=Entire%20home%2Fapt"

To something like:

Dim Last Row As Long

LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row

myUrl = Range("C2:C & Last Row")

Thanks for your help to date its brillaint.

 

[Anthony47]

You have to KNOW that the macro stops and at that point you may change the search parametres and re-execute the search (if you change the parametres), then YOU must restart the macro using F5 or the "Continue" button; a more sophisticated interface would require much effort.

Remaining at the "poor man" level automation, I have done some modification so that now:
1) the urls list is on a workbook
2) if only one url is set, then a messagebox will inform about the possibility for changing the search. Note that it might happen that the messagebox be hidden by the Chrome window; if that happens it will look like Chrome is freezed: activate the Excel window and the message should be visible.
This messagebox is not available if two or more url are listed
3) Each Description now brings a hyperling to the corresponding element

All these features correspond to this penultimate version of the macro:

Sub ABBInfoV22()
Dim wPage As Object
''Dim wPage As Selenium.WebDriver
Dim myUrl As String, I As Long
Dim NextR As Long, NextP As Long
Dim pColl As Object, aptColl As Object
Dim LastUrl As Long, vOff As Long, eCnt As Long, bCnt As Long
Dim picColl As Object, aColl As Object, LoopMode As Boolean
Dim uSh As Worksheet, mMsg As String, uRan As Range
'
'
Set uRan = Sheets("Sheet1").Range("C2")             '<<< The starting position of URLs
'
'Crea Driver:
Set wPage = CreateObject("Selenium.CHRomedriver")
ReUrl:
'Loop for each Url:
myUrl = uSh.Cells(2, "C").Offset(vOff, 0).Value
myUrl = uRan.Offset(vOff, 0).Value
If InStr(1, myUrl, "http", vbTextCompare) <> 1 Then
    AppActivate (Application.Caption)
    mMsg = "Completed, " & vOff & " Url(s), " & bCnt & " blocks, " & eCnt & " Elements"
    MsgBox (mMsg)
    Debug.Print mMsg & vbCrLf
    GoTo SQuit
End If
vOff = vOff + 1
If uRan.Offset(vOff, 0).Value <> "" Then
    LoopMode = True
End If
Debug.Print ">>>> Start, LoopMode=" & LoopMode & ", URL=" & vOff
'
wPage.Get myUrl
Sheets("Main").Select
Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) = myUrl

If LoopMode = False Then
    AppActivate (Application.Caption)
    MsgBox ("Now you may modify and re-execute the Search on the Chrome window" & vbCrLf _
        & "When you have done, close the MessageBox to Continue")
End If
'
'Extracting block of info:
ReLoop:
bCnt = bCnt + 1
'Wait for the list to be ready:
For I = 1 To 10
    Set aptColl = wPage.FindElementsByClass("g1tup9az")
    wPage.Wait 400
    If aptColl.Count > 0 Then Exit For
Next I
NextP = NextP + 1
'lock the collection of elements:
Set aptColl = wPage.FindElementsByClass("g1tup9az")
Set picColl = wPage.FindElementsByClass("c14whb16")
Debug.Print "Apt found=" & aptColl.Count, "I=" & I, "Page=" & NextP
Range("A1:C1").Value = Array("Description", "Overview", "Price")
'Read each element:
For I = 1 To aptColl.Count
    eCnt = eCnt + 1
    Set aColl = picColl(I + 1).FindElementsByTag("a")
    NextR = Cells(Rows.Count, 1).End(xlUp).Row + 1
    Set pColl = aptColl(I).FindElementsByTag("div")
    Cells(NextR, 1) = pColl(1).Text
    Cells(NextR, 1).Style = "Normal"
    If aColl.Count > 0 Then                                     'Add the hyperlink
        ActiveSheet.Hyperlinks.Add Anchor:=Cells(NextR, 1), _
               Address:=aColl(1).Attribute("href")
    End If
    Cells(NextR, 2) = Replace(pColl(2).Text, Chr(10), " ", , , vbTextCompare)
    Cells(NextR, 3) = Replace(pColl(7).Text, Chr(10), " ", , , vbTextCompare)
    DoEvents
Next I
'
'Accept cookies
Set aptColl = wPage.FindElementsByClass("_148dgdpk")
If aptColl.Count = 1 Then aptColl(1).Click: wPage.Wait 100
'
'Search Next & click:
Set aptColl = wPage.FindElementsByClass("_jro6t0")
If aptColl.Count > 0 Then
    Set pColl = aptColl(1).FindElementsByTag("a")
    For I = 1 To pColl.Count
        If pColl(I).Attribute("aria-label") = "Next" Then
            pColl(I).Click
            Debug.Print "Next 20"
            wPage.Wait 990
            GoTo ReLoop
        End If
    Next I
End If
If LoopMode Then
    GoTo ReUrl
Else
    AppActivate (Application.Caption)
    mMsg = "Completed, " & "1 Url(s), " & bCnt & " blocks, " & eCnt & " Elements"
    MsgBox (mMsg)
    Debug.Print mMsg & vbCrLf
End If
Beep
SQuit:
wPage.Quit
Set wPage = Nothing
End Sub

The starting position for the URL list can be described by the line marked <<<, at the beginning

Try…

 

[jamescooper]

Thank you so much it works very nicely indeed!

 

[Anthony47]

Thank you for the feedback
It would be better if you mark the discussion as "Solved"; see Mark as Solution