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]

My demo workbook can be downloaded from here: ABnB_Demo.xlsm

I an using Sub ABBInfoV44 and now I REALIZE that in my message #17 I published Sub ABBInfoV33, the same version that didn't work the day before

In other words, I didn't published the updated version

 

[jamescooper]

My demo workbook can be downloaded from here: ABnB_Demo.xlsm

I an using Sub ABBInfoV44 and now I REALIZE that in my message #17 I published Sub ABBInfoV33, the same version that didn't work the day before

In other words, I didn't published the updated version

Works like a treat, thank you so much Anthony47.

 

[Anthony47]

Thank you for the feedback
And, btw, for those that don't want to download the demo file, this is the code for the unpublished Sub ABBInfoV44:

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
Dim aptTop As Object
'
'
Set uRan = Sheets("Sheet1").Range("C2")             '<<< The starting position of URLs
'
'Crea Driver:
Set wPage = CreateObject("Selenium.CHRomedriver")
ReUrl:
'Loop for each Url:
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 are ready 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")
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
    Set aptTop = aptColl(I).FindElementByXPath("./..")
    Set aColl = aptTop.FindElementsByTag("a")
    eCnt = eCnt + 1
    NextR = Cells(Rows.Count, 1).End(xlUp).Row + 1
    Set pColl = aptTop.FindElementsByClass("t1jojoys")
    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(aptTop.FindElementsByClass("s1cjsi4j")(1).Text, Chr(10), " ", , , vbTextCompare)
    Cells(NextR, 3) = Replace(aptTop.FindElementsByClass("p1v28t5c")(1).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