1
votes

I would like to get table to Worksheet in Excel after search has been performed. My code is accessing web page, inputs values from Worksheet but I am not able to extract table to Excel. Any ideas what is wrong in my current code and how to get it work?

    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 

Here is HTML of web page and table I would like to have on my worksheet:

enter image description here

2

2 Answers

1
votes

A re-write I would use would include a timed loop to ensure table has had time to load and exit if no table present. The performance hit for using attribute selectors, which are far more descriptive and self-evidencing in what they are doing, over, for example, class selectors is so small as to be insignificant in this case.

'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
1
votes

travels_tableOutbound is the ID of the element not the tag name, hence you should use getElementById instead getElementsByTagName

Set trs = tbl.getElementsByTagName("travels_tableOutbound")

should be

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


Option 2 use query selector to get the elements:

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