Блог

Мне нужно извлечь таблицу из результата поиска веб-страницы, которая предоставляет декодер VIN. Я много раз пробовал следующие коды, но мне не удалось извлечь. На самом деле, я попытался изменить код, который кто-то загрузил, но ошибка не возникает, но ничего не извлекается. Необходимо было вывести vin-код из листов (1) и добавить в конец URL. Кроме того, результат поиска на веб-сайте vin decoder содержит так много таблиц, что я не смог указать нужную мне таблицу.

 Sub WebScrape()

Dim ie As Object, i As Long, strText As String

Dim doc As Object, hTable As Object, hBody As Object, hTR As Object, hTD As Object, hHead As Object
Dim tb As Object, bb As Object, tr As Object, td As Object, hth As Object, hh As Object

Dim y As Long, z As Long, wb As Excel.Workbook, ws As Excel.Worksheet

For i = 2 To 386
pagenum = Sheets(1).Cells(i, 2).Value

Set wb = Excel.ActiveWorkbook
Set ws = wb.ActiveSheet

Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = False

y = 1 'Column A in Excel
z = 1 'Row 1 in Excel

ie.navigate "https://en.vindecoder.pl/" amp; pagenum


Do While ie.Busy: DoEvents: Loop
Do While ie.readyState <> 4: DoEvents: Loop


Set doc = ie.document
Set hTable = doc.getElementsByTagName("table")
For Each tb In hTable
'tTable > thead > tr > th
Set hHead = tb.getElementsByTagName("tbody")
For Each hh In hHead
Set hTR = hh.getElementsByTagName("tr")
For Each tr In hTR

Set hth = tr.getElementsByTagName("th")
y = 1 ' Resets back to column A
For Each th In hth
Debug.Print th.innerText
ws.Cells(z, y).Value = th.innerText
y = y   1
Next th
DoEvents

Next tr
Exit For

Next hh
'th.innerText


Set hBody = tb.getElementsByTagName("tbody")
For Each bb In hBody

Set hTR = bb.getElementsByTagName("tr")
For Each tr In hTR

Set hTD = tr.getElementsByTagName("td")
y = 1 ' Resets back to column A
For Each td In hTD
Debug.Print td.innerText
z = 2
ws.Cells(z, y).Value = td.innerText
y = y   1
Next td
DoEvents
z = z   1
Next tr
Exit For
Next bb
'Exit For
Next tb
ie.Quit
Next

End Sub