Соскрести таблицу с веб-страницы

Question

Я хотел бы получить таблицу для рабочего листа в Excel после того, как поиск был выполнен.Мой код обращается к веб-странице, вводит значения из рабочего листа, но я не могу извлечь таблицу в Excel.Любые идеи, что не так в моем текущем коде и как заставить его работать?

    Sub GetFerryRatesAutomatic()
    Dim appIE As Object
        Dim tbl, trs, tr, tds, td, r, c

    Set appIE = CreateObject("internetexplorer.application")
    With appIE
        .Navigate "https://laevapiletid.ee/setlang/eng"
        .Visible = True
    End With

    Do While appIE.Busy
        DoEvents
    Loop

    appIE.Document.getElementsByName("trip_outbound")(0).Value = "HEL-TAL"
    appIE.Document.getElementsByName("trip_inbound")(0).Value = "TAL-HEL"

    appIE.Document.getElementsByName("vehicle")(0).Value = "CAR1"

    appIE.Document.getElementsByName("passenger[ADULT]")(0).Value = ThisWorkbook.Sheets("Other Data").Range("F18")

    appIE.Document.getElementsByName("trip_inbound_date")(0).Value = ThisWorkbook.Sheets("Other Data").Range("F20")
    appIE.Document.getElementsByName("trip_outbound_date")(0).Value = ThisWorkbook.Sheets("Other Data").Range("F19")

    appIE.Document.getElementsByClassName("btn btn-lg btn-block btn-primary")(0).Click

'This part is for extracting table

    Set tbl = appIE.Document.getElementsByTagName("travelSelect")(5)
        Set trs = tbl.getElementsByTagName("travels_tableOutbound")

        For r = 0 To trs.Length - 1
            Set tds = trs(r).getElementsByTagName("td")
            If tds.Length = 0 Then Set tds = trs(r).getElementsByTagName("th")

            For c = 0 To tds.Length - 1
                ActiveSheet.Range("A1").Offset(r, c).Value = tds(c).innerText
            Next c
        Next r

    'appIE.Quit
    Set appIE = Nothing

    End Sub 

Вот HTML-код веб-страницы и таблицы, которые я хотел бы иметь на своем листе:

Answer 1

Перезапись, которую я бы использовал, включала бы синхронизированный цикл, чтобы убедиться, что таблица успела загрузить и выйти, если таблицы нет. Падение производительности при использовании селекторов атрибутов, которые гораздо более информативны и самоочевидны в том, что они делают, например, над селекторами классов, настолько мало, что в этом случае они незначительны.

'VBE > Tools > References: Microsoft Internet Controls
Public Sub GetPriceInfo()
    Dim ie As New InternetExplorer, url As String, ws As Worksheet
    Dim t As Date, clipboard As Object, hTable As Object
    url = "https://laevapiletid.ee/"
    Const ADULTS As Long = 2
    Const MAX_WAIT_SEC As Long = 10

    Set ws = ThisWorkbook.Worksheets("Sheet1")
    Set clipboard = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")

    With ie
        .Visible = True
        .Navigate2 url

        While .Busy Or .readyState < 4: DoEvents: Wend

        With .document
            .querySelector("[name=trip_outbound] [value='HEL-TAL']").Selected = True
            .querySelector("[name=trip_outbound_date]").Value = "14.05.2019"
            .querySelector("[name=trip_inbound] [value='TAL-HEL']").Selected = True
            .querySelector("[name=trip_inbound_date]").Value = "15.05.2019"
            .querySelector("#adultSpinnerValue").Value = ADULTS
            .querySelector("[name=vehicle] [value='NONE']").Selected = True
            .querySelector("[type=submit]").Click

            t = Timer
            Do
                On Error Resume Next
                Set hTable = .querySelector("#travels_tableOutbound")
                On Error GoTo 0
                If Timer - t > MAX_WAIT_SEC Then Exit Do
            Loop While hTable Is Nothing
        End With

        If InStr(hTable.outerHTML, "Arvutan...") > 0 Then
            t = Timer
            Do
                If Timer - t > MAX_WAIT_SEC Then Exit Do
            Loop Until Not InStr(hTable.outerHTML, "Arvutan...") > 0
            Set hTable = .document.querySelector("#travels_tableOutbound")
        End If

        If hTable Is Nothing Then Exit Sub
        clipboard.SetText hTable.outerHTML
        clipboard.PutInClipboard
        ws.Range("A1").PasteSpecial
        .Quit
    End With
End Sub

Answer 2

travels_tableOutbound - это идентификатор элемента, а не имя тега, поэтому вместо него следует использовать getElementById getElementsByTagName

Set trs = tbl.getElementsByTagName("travels_tableOutbound")

должно быть

Set trs = appIE.Document.getElementsByTagName("travels_tableOutbound")

---

Вариант 2 использует селектор запросов для получения элементов:

Set trs = appIE.Document.querySelector("#travels_tableOutbound")