Я бы дал selenium basic wrapper для vba попробовать, если вам разрешено установить. После установки вы добавляете ссылку на библиотеку типов селена через vbe> инструмент> ссылки. Вам нужна последняя версия Chrome для установки и chromedriver, а файл chromedriver.exe должен находиться в той же папке, что и исполняемые файлы Selen.
Тогда синтаксис вашей задачи будет приятным и описательным. Я не добавил петлю для vins, но показаны основные элементы для поиска. Я предоставляю подпрограмму для записи результатов на лист.
Я хотел бы иметь возможность убрать явное ожидание после SendKeys, но, по-видимому, нет событий / изменений страницы, которые я могу отслеживать, чтобы определить, когда нажимать кнопку и включить отправленный vin. Ожидание в 1 секунду кажется достаточным. Вы можете уменьшить это в зависимости от того, сколько поисков вы выполняете.
Option Explicit
Public Sub SearchVins()
Dim d As WebDriver, hTable As Object, ws As Worksheet, t As Date
Dim headers(), vin As String
Const MAX_WAIT_SEC As Long = 10
Set d = New ChromeDriver
Set ws = ThisWorkbook.Worksheets("Sheet1")
Const URL = "https://www.autoreturn.com/indianapolis-in/find-vehicle/"
headers = Array("License", "State", "Make", "Model", "Color", "Vin", "Status", "Tow date and Time")
vin = "1G4HD57287U218052"
With d
.Start "Chrome"
.get URL
.FindElementById("vin").SendKeys vin '<== vin
Application.Wait Now + TimeSerial(0, 0, 1)
.FindElementByCss("[onclick='submitVin()']").Click
t = Timer
Do
DoEvents
On Error Resume Next
Set hTable = .FindElementByCss("table") 'use tag name of results table to target table
On Error GoTo 0
If Timer - t > MAX_WAIT_SEC Then Exit Do
Loop While hTable Is Nothing
'do something with results
If Not hTable Is Nothing Then
WriteTable hTable, LastRow(ws) + 2, ws
Set hTable = Nothing
End If
.FindElementByCss("a.more-link").Click '<== search again button
'Another search for example.....
Stop '<==Delete me later
ws.Cells(2, 2).Resize(1, UBound(headers) + 1) = headers '<== Finally add headers
.Quit
End With
End Sub
Public Sub WriteTable(ByVal hTable As Object, ByVal startRow As Long, ByVal ws As Worksheet)
Dim tr As Object, td As Object, r As Long, c As Long
r = startRow
For Each tr In hTable.FindElementsByTag("tr")
c = 1
For Each td In tr.FindElementsByTag("td")
ws.Cells(r, c) = td.Text
c = c + 1
Next
r = r + 1
Next
End Sub
Public Function LastRow(ByVal sh As Worksheet) As Long
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function