運行時錯誤91.試圖在一個子文件夾中循環移動多個值

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的路時，我找不到一個有效的數字，它將一路走下去直到最後一個循環，並給我那個錯誤。總而言之，我試圖用一個按鈕來拉動幾個城市的飛行數據，並且將不得不根據時間來組織數據（我仍然需要將am/pm轉換爲軍事時間和排序）。如果你嘗試編碼，它會給你msp和slc飛行數據，但不是atl（第67行= 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 （ETC）使用適當的計數器：

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