Untitled

jdelano

Jun 25th, 2025

1,663

Never

Add comment

Not a member of Pastebin yet? Sign Up, it unlocks many cool features!

VisualBasic 4.66 KB | None | 0 0

raw download clone embed print report

Private Sub btnGetInfo_Click()
' loop the table to find the information for eac registration
Dim sheetRow As Long
Dim siteURL As String
Dim registration As String
Dim lastRow As Long
Dim listDIVs As WebElements ' all the div elements inside where the Registration / Fleet Number info is
Dim listDiv As WebElement ' each div
Dim anchorElement As WebElement ' the element that contains the anchor to click (its text equals col A in the sheet)
Dim subDIVs As WebElements ' all the div elements showing the data after clicking the registration
Dim cDriver As ChromeDriver
' create a chomedriver object
Set cDriver = New ChromeDriver
siteURL = "https://www.planespotters.net/search?q="
lastRow = Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row ' which row is the last one used
' loop the data on the sheet - change the 5 to whatever the data starts in the future
For sheetRow = 5 To lastRow
registration = Sheet1.Cells(sheetRow, "A").Value
' open Chrome and go to the specified address
cDriver.Get siteURL & registration
cDriver.Wait 2000 ' wait 2 seconds for the page to load
' find where the registration anchor is (clickable link), this is found by using
' the inspect option in the right click menu in chrome when viewing the webpage
Set listDIVs = cDriver.FindElementsByClass("dt-tr")(2).FindElementsByTag("div")
For Each listDiv In listDIVs
If listDiv.FindElementByTag("a").Text <> "" Then
' this is a div that contains a link to click
Set anchorElement = listDiv.FindElementByTag("a")
' if the link text matches the registration info from teh sheet then leave the loop
If anchorElement.Text = registration Then Exit For
End If
Next listDiv
' click the link that was found above
anchorElement.Click
cDriver.Wait 2000 ' wait 2 seconds for the page to load
' get the divs that make up the location of the data in the page
On Error Resume Next
Set subDIVs = cDriver.FindElementByClass("flex-column").FindElementsByClass("dt-tr")
If Err <> 0 Then
' there may be an advert infront of the data that needs to be cleared before moving on
MsgBox "The webpage isn't displaying corrently. Click close on the advertisement then click OK on this message to continue", vbOKOnly, "Page Issue"
Set subDIVs = cDriver.FindElementByClass("flex-column").FindElementsByClass("dt-tr")
End If
Err = 0
On Error GoTo 0
Sheet1.Cells(sheetRow, "D").Value = SearchDIVs("MSN", subDIVs) ' MSN
Sheet1.Cells(sheetRow, "C").Value = SearchDIVs("Line Number", subDIVs) ' Line Number
Sheet1.Cells(sheetRow, "B").Value = SearchDIVs("Aircraft Type", subDIVs) ' aircraft type
Sheet1.Cells(sheetRow, "E").Value = cDriver.FindElementByTag("h1").Text ' airline/company
' remove the aircraft type from the airline company text at the top of the page
Sheet1.Cells(sheetRow, "E").Value = Replace(Sheet1.Cells(sheetRow, "E").Value, UCase(Sheet1.Cells(sheetRow, "B").Value), "")
Set subDIVs = Nothing
DoEvents
Next sheetRow
Set listDIVs = Nothing
cDriver.Close
Set cDriver = Nothing
MsgBox "Done."
End Sub
Private Function SearchDIVs(valueTitle As String, subDIVs As WebElements) As String
' go through each div text in the list of divs passed.
' find the value associated to the title
Dim subDiv As WebElement
Dim titleDiv As WebElement
Dim valueDiv As WebElement
For Each subDiv In subDIVs
' get the data from the 2 divs inside the list div
Set titleDiv = subDiv.FindElementsByTag("div")(1)
Set valueDiv = subDiv.FindElementsByTag("div")(2)
If InStr(titleDiv.Text, valueTitle) > 0 Then
If valueTitle = "Aircraft Type" Then
' the aircraft type has an unordered list with a list element inside it
' unlike the other items wanted from the web page
SearchDIVs = subDiv.FindElementsByTag("li")(2).Text
Else
SearchDIVs = valueDiv.Text
End If
Exit Function
End If
Next subDiv
SearchDIVs = ""
End Function

Add Comment

Please, Sign In to add comment