Question

首先，感谢stackoverflow用户帮助我获得一个城市（MSP）的正确代码。但是，现在我正在尝试循环并为几个城市提取数据。目前，只有MSP，SLC，LAX和ATL。我需要稍后再添加。此外，如果我需要移动地点，我可能会从现在的10-15个航班到现在的40天，我明白这会非常慢。

无论如何，在尝试获取多个城市的航班数据时，我必须不断调整＆＃34;对于i = 0到40＆＃34;在每一个上它都没有给我一个运行时错误91.到目前为止我已经得出结论，slc需要在＆＃34;对于i = 0到35＆＃34;当msp设置为40时。当代码实现了atl的方式时，我找不到一个有效的数字，它将一直一步到最后一个循环并给我错误。

总之，我试图用一个按钮为几个城市提取飞行数据，并且必须根据时间组织数据（我仍然需要将上午/下午转换为军事时间和排序）。如果您尝试输出代码，它将为您提供msp和slc航班数据，但不是atl（第67行a = Doc.getElem ...）。我将不得不在以后添加更多城市。

Sub populateFlightInfo()
'declare variables
        Dim Doc As HTMLDocument
        Dim i As Integer, f As Integer, count As Integer
        Dim cityPair As String

    For q = 0 To 4
        If q = 0 Then
        cityPair = "MSP"
        GoTo msp
        ElseIf q = 1 Then
        cityPair = "SLC"
        GoTo slc
        ElseIf q = 2 Then
        cityPair = "ATL"
        GoTo atl
        Else
        GoTo terminate
        End If
msp:
        'run internet explorer
        Dim IE As New InternetExplorer
        count = 0
        IE.navigate "https://assistive.usablenet.com/tt/www.delta.com/flightinfo/viewFlightSchedules.action?departureAirportCode=bzn&flightDate=" _
        & "2015-08-23" & "&arrivalAirportCode=" & cityPair
            Do
                DoEvents
            Loop Until IE.readyState = READYSTATE_COMPLETE
        Set Doc = IE.document

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

slc:
        'run internet explorer
        Dim IG As New InternetExplorer
        count = 1
        IG.navigate "https://assistive.usablenet.com/tt/www.delta.com/flightinfo/viewFlightSchedules.action?departureAirportCode=bzn&flightDate=" _
        & "2015-08-23" & "&arrivalAirportCode=" & cityPair
            Do
                DoEvents
            Loop Until IG.readyState = READYSTATE_COMPLETE
        Set Doc = IG.document

        For i = 0 To 35
        On Error GoTo second
           a = Doc.getElementsByClassName("schedulesTableCell")(i)
        Next
        GoTo second
atl:
        'run internet explorer
        Dim IY As New InternetExplorer
        count = 2
        IY.navigate "https://assistive.usablenet.com/tt/www.delta.com/flightinfo/viewFlightSchedules.action?departureAirportCode=bzn&flightDate=" _
        & "2015-08-23" & "&arrivalAirportCode=" & cityPair
            Do
                DoEvents
            Loop Until IY.readyState = READYSTATE_COMPLETE
        Set Doc = IY.document

        For i = 0 To 50
        On Error GoTo second
           a = Doc.getElementsByClassName("schedulesTableCell")(i)
        Next
        GoTo second
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

                Range("F35").End(xlUp).offSet(1, 0).Value = Right(Replace(flt, " *", ""), 6)
                Range("F35").End(xlUp).offSet(0, 1).Value = Trim(Left(dep, 7))
                Range("F35").End(xlUp).offSet(0, 2).Value = cty
            If InStr(flt, Chr(42)) > 0 Then
                offSet = offSet + 1
            End If
            Next r
        If count = 0 Then
        IE.Quit
        ElseIf count = 1 Then
        IG.Quit
        ElseIf count = 2 Then
        IY.Quit
        Else
        End If

    Next q
terminate:


End Sub

Answer 1

如果您不知道将要使用多少元素，请更改迭代元素的方式，例如使用集合：

Dim divColl As Object
'// rest of code ...
Set divColl = Doc.getElementsByClassName("schedulesTableCell")

For i = 0 To divColl.Length - 1
    a = divColl(i)
Next i
'// rest of code...

Answer 2

使用适当的计数器来代替硬编码循环For i = 0 to 50（等）：

For i = 0 to Doc.getElementsByClassName("schedulesTableCell").Length - 1

但是，您甚至没有对该循环的内容做任何事情，您将其分配给变量a。所以这些循环以及a的赋值完全没必要。

我简化了这段代码，以避免GoTo循环的意大利面效应，以及On Error Resume Next的误用。主要程序populateFlightInfo初始化一系列城市代码，您可以根据需要进行修改。然后它使用For Each循环并将每个城市名称和日期传递给另一个提取信息的过程。你可以修改它来打印到工作表，现在它只是显示msgbox来显示信息。

这只使用一个Internet Explorer实例，而不是您可能创建的几个实例。此代码应更加分区，并且更易于修改以满足将来的需求。如果您有任何问题，请告诉我。

Option Explicit

Const baseURL As String = "https://assistive.usablenet.com/tt/www.delta.com/flightinfo/viewFlightSchedules.action?departureAirportCode=bzn&flightDate="

Sub populateFlightInfo()
'declare variables

        Dim strDate As String
        Dim cityList As Variant
        Dim city As Variant

        'Assign the date string:
        strDate = "2015-08-23"

        'Create an array/list of the cities, modify as needed
        cityList = Array("MSP", "SLC", "ATL")

        'Iterate over the array defined above:
        For Each city In cityList

            'Call another procedure to do the IE automation/retrieval
            Call GetFlightInfo(city, strDate)


        Next

End Sub

Sub GetFlightInfo(city As Variant, strDate As String)
        Dim IE As New InternetExplorer
        Dim url As String
        Dim elements As Object
        Dim ele As Object
        Dim Doc As HTMLDocument
        Dim r As Integer
        Dim offset As Integer
        Dim flt$, dep$, cty$

        'Construct the full url:
        url = baseURL & strDate & "&arrivalAirportCode=" & city

        'Navigate to the URL
        IE.Visible = True
        IE.navigate url
            Do
                DoEvents
            Loop Until IE.readyState = READYSTATE_COMPLETE

        Set Doc = IE.document

        Set elements = Doc.getElementsByClassName("schedulesTableCell")

        'iterate over the elements collection:
        ' and display flight info in msgbox
        ' you can modify to print on the worksheet
        Do


            flt = elements(r + offset).innerText
            dep = Trim(elements(r + 2 + offset).innerText)
            cty = elements(r + 3 + offset).innerText

            Debug.Print "City: " & city & vbTab & flt & vbTab & dep & vbTab & cty

            'Find the asterisk and adjust the offset
            If InStr(flt, Chr(42)) > 0 Then offset = offset + 1

            'MsgBox flt & vbTab & dep & vbTab & cty

            i = i + 1
            r = i * 9
        Loop While Not (r + offset) >= elements.Length - 1

        IE.Quit

End Sub

运行时错误91.尝试循环.navigate在一个sub中的几个值

2 个答案: