使用 vba 从 delta.com 检索航班数据

Question

我正在尝试使用 vba 从 delta.com 获取航班数据。城市是Bozeman (BZN)，我只需要BZN -> MSP 路线。我尝试单步执行代码，它到处跳。有时，它会显示所有数据。

有错误的部分是日期2015-08-23。真的是有达美联运航班的任何一天。我推断这一定是因为网站上显示 Delta Connection 标签的信息框的类名称为 schedulesTableCell，就像表中的所有其他框一样。

那天的输出应该是：

1203 上午 6:00 MSP 4518 上午 9:00 MSP 2287 上午 11:05 MSP 2318 下午 1 点 25 分 MSP

但是，很多时候它表现为一个变体，其中一些是：

1)

1203 上午 6:00 MSP 4518 上午 9:00 MSP

2)

1203 上午 6:00 MSP 4518 上午 9:00 MSP 第2287章

3)

1203 上午 6:00 MSP 4518 上午 9:00 MSP 2287 上午 11:05 MSP

请注意，我曾尝试数数以查看是否存在模式，但无法立即找到。当然，我假设任何模式都会在 20 次尝试中显示出来。

而且我必须使用 vba，因为这将有助于减少我的工作量。

Sub populateFlights()
    'declare variables
    Dim Doc As HTMLDocument
    Dim IE As New InternetExplorer

    'run internet explorer
    IE.navigate "https://assistive.usablenet.com/tt/www.delta.com/flightinfo/viewFlightSchedules.action?departureAirportCode=bzn&flightDate=" _
    & Range("Date").Text & "&arrivalAirportCode=msp"
        Do
            DoEvents
        Loop Until IE.readyState = READYSTATE_COMPLETE

    'set variable values
    Dim findFlt As Integer
    Dim flt As String, dep As String, cty As String, city As String
    Dim r
    Set Doc = IE.document
    findFlt = -1
    offTime = -7
    city = Range("B3").Text

    'fill in flight info
    For r = 0 To 4
        On Error Resume Next
        findFlt = findFlt + 1
        offTime = offTime + 9

        'retrieve data from delta.com
        flt = Doc.getElementsByName("flightNumber")(findFlt).Value
        dep = Trim(Doc.getElementsByClassName("schedulesTableCell")(offTime).innerText)
        cty = Doc.getElementsByName("legArrivalAirportCode")(findFlt).Value

        IE.Quit

        'skip duplicate flights from data loop
        If flt = Range("F35").End(xlUp).Text Then
            GoTo Skip
        End If
        Range("F35").End(xlUp).offSet(1, 0).Value = flt

        'forward one box if city was retrieved instead of scheduled departure time. This is where I try to adjust for delta connection box
        If dep = city Then
            offTime = offTime + 1
            dep = Trim(Doc.getElementsByClassName("schedulesTableCell")(offTime).innerText)
            'trim date from response
            Range("F35").End(xlUp).offSet(0, 1).Value = Trim(Mid(dep, 1, InStr(dep, "M")))

        'continue code
        Else
        'trim date from response
        Range("F35").End(xlUp).offSet(0, 1).Value = Trim(Mid(dep, 1, InStr(dep, "M")))
        End If

        Range("F35").End(xlUp).offSet(0, 2).Value = cty
Skip:
    Next r
    findFlt = -1

End Sub

Answer 1

您提供的数组索引（offTime 和 findFlt）并不总是正确的，从而导致了问题。但是，因为 Delta 提供的表格是 9 列宽（除了 * 行），所以下面应该可以工作。

Sub populateFlights()
'declare variables
Dim Doc As HTMLDocument
Dim IE As New InternetExplorer
Dim i As Integer
'run internet explorer
IE.navigate "https://assistive.usablenet.com/tt/www.delta.com/flightinfo/viewFlightSchedules.action?departureAirportCode=bzn&flightDate=" _
& Range("DATE").Text & "&arrivalAirportCode=msp"
    Do
        DoEvents
    Loop Until IE.readyState = READYSTATE_COMPLETE
Set Doc = IE.document

For i = 0 To 1000
On Error GoTo second
   a = Doc.getElementsByClassName("schedulesTableCell")(i)
Next

second:
Offset = 0
    For r = 0 To (i / 9) - 1

        flt = Doc.getElementsByClassName("schedulesTableCell")((r * 9) + Offset).innerText
        dep = Trim(Doc.getElementsByClassName("schedulesTableCell")((r * 9) + 2 + Offset).innerText)
        cty = Doc.getElementsByClassName("schedulesTableCell")((r * 9) + 3 + Offset).innerText

        Cells(1 + r, 6) = Right(Replace(flt, " *", ""), 4)
        Cells(1 + r, 7) = Trim(Left(dep, 7))
        Cells(1 + r, 8) = cty
    If InStr(flt, Chr(42)) > 0 Then
        Offset = Offset + 1
    End If
    Next r
IE.Quit
End Sub