Итеративный выпуск IE Navigate

Question

Я пытаюсь получить атрибуты для примерно 500 кодов CAGE из DLA и записать их в мою электронную таблицу. Мне удалось заставить его работать за одну итерацию, но на второй итерации выдается ошибка «метод навигация объекта iwebbrowser2 не удалось»

Обратите внимание, что код не работает, если вы уже не открыливеб-сайт ранее и еще не закрыли браузер (вам необходимо принять условия).

Ячейка B2 = https://cage.dla.mil/Search/Results?q=07187&page=1 Ячейка B3 = https://cage.dla.mil/Search/Results?q=00198&page=1

Sub NSCM2()

'Initialize
Dim IE As Object
Dim CAGE As String
Dim rowNeeded As String
Dim i As Integer
Dim sDD0 As String
Dim sDD1 As String
Dim sDD2 As String
Dim sDD3 As String
Dim sDD4 As String
Dim Doc As HTMLDocument

'Create IE Object
Set IE = CreateObject("INTERNETEXPLORER.APPLICATION")

'Loop for All Codes
For i = 1 To 10

  'Retrieve CAGE Code
  rowNeeded = CStr(i + 1)
  CAGE = Range("B" & rowNeeded).Value

'Navigate to Cage Code general Page
IE.navigate CAGE

  'Wait
  Do
    DoEvents
    Loop Until IE.readyState = 4
    Application.Wait (Now + TimeValue("0:00:03"))

  'Follow link to details page
  For Each ele In IE.document.getElementsByTagName("a")
      If InStr(ele.innerText, "Details") > 0 Then ele.Click
  Next

  'Wait
  Do
    DoEvents
    Loop Until IE.readyState = 4
    Application.Wait (Now + TimeValue("0:00:03"))

  'Pull needed values
  Set Doc = IE.document

  sDD0 = Doc.getElementsByTagName("span")(11).innerText
  sDD1 = Doc.getElementsByTagName("span")(15).innerText
  sDD2 = Doc.getElementsByTagName("span")(17).innerText
  sDD3 = Doc.getElementsByTagName("span")(19).innerText
  sDD4 = Doc.getElementsByTagName("span")(20).innerText

  'Close IE
  IE.Quit

  'Insert URL
  Range("F" & rowNeeded) = sDD0

  'Insert Address, comma separated
  If sDD1 = "" And sDD2 = "" And sDD3 = "" Then
    Range("G" & rowNeeded) = sDD4
    ElseIf sDD1 = "" And sDD2 = "" Then
    Range("G" & rowNeeded) = sDD3 & ", " & sDD4
    ElseIf sDD1 = "" And sDD3 = "" Then
    Range("G" & rowNeeded) = sDD2 & ", " & sDD4
    ElseIf sDD1 = "" Then
    Range("G" & rowNeeded) = sDD2 & "," & sDD3 & ", " & sDD4
    Else
    Range("G" & rowNeeded) = sDD1 & ", " & sDD2 & ", " & sDD3 & ", " & sDD4
    End If

  'Insert Address Check
  Range("H" & rowNeeded) = sDD1 & ";" & sDD2 & ";" & sDD3 & ";" & sDD4

Next i

End Sub

Answer 1

В первый раз в цикле вы вызываете

IE.Quit

, поэтому ваш цикл завершится ошибкой во второй итерации