运行时错误91.试图在一个sub中循环导航多个值

Question

首先，感谢stackoverflow用户帮助我获得一个城市（MSP）的正确代码。但是，现在我正在尝试循环它，并提取几个城市的数据。目前，只有MSP、SLC、LAX和ATL。我稍后需要添加更多内容。此外，如果我需要搬家，我可能会从现在每天10-15班的航班增加到40班，我知道这会变得非常慢。

无论如何，在尝试获取几个城市的航班数据时，我必须不断调整每个城市的"for I=0 to 40"，这样它就不会给我带来运行时错误91。到目前为止，我已经得出结论，当msp设置到40时，slc需要处于"For I=0 to 35"。当代码到达atl时，我找不到一个有效的数字，它会一直走到最后一个do循环，并给我这个错误。

总之，我正试图用一个按钮提取几个城市的飞行数据，并且必须根据时间组织数据（我仍然需要将上午/下午转换为军事时间并进行排序）。如果你试一下这个代码，它会给你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循环，并将每个城市名称和日期传递给另一个提取信息的过程。您可以修改它以打印到工作表中，现在它只需显示消息框即可向您显示信息。

这只使用一个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