Question

我正在尝试使用vba从delta.com获取航班数据。这个城市是 Bozeman（ BZN ），我只需要BZN -> MSP路线。我试着单步执行代码，它随处可见。有时，它会显示所有数据。

出现错误的部分是日期2015-08-23。真的有Delta Connection航班的任何一天。我推断它必须是因为网站上显示Delta Connection标签的信息框的类名为schedulesTableCell，就像表中的其他每个框一样。

当天，输出应为：

1203    6:00AM  MSP
4518    9:00AM  MSP
2287    11:05AM MSP
2318    1:25PM  MSP

但是，很多时候它似乎是一种变体，其中一些是：

1）

1203    6:00AM  MSP
4518    9:00AM  MSP

2）

1203    6:00AM  MSP
4518    9:00AM  MSP
2287        MSP

3）

1203    6:00AM  MSP
4518    9:00AM  MSP
2287    11:05AM 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

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

1 个答案: