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
Dim dtToday As String
dtToday = Format(Date, "dd/mm/yyyy")
Lastrow = Sheets("Data").Range("A" & Rows.Count).End(xlUp).Row
Application.Calculation = xlManual
Set uRan = Sheets("date requests").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("data").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:G1").Value = Array("Description", "Overview", "Price", "Check-in date", "Check-out date", "Date checked", "Days out")
'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)
Cells(NextR, 4) = Mid(myUrl, 117, 10)
Cells(NextR, 5) = Mid(myUrl, 137, 10)
Cells(NextR, 6) = dtToday
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
Application.Calculation = xlAutomatic
End Sub
