excel - 从网页中抓取表格

Question

执行搜索后，我想在 Excel 中获取表格到工作表。我的代码正在访问网页，从 Worksheet 输入值，但我无法将表格提取到 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