Excel vba 運行時錯誤 91 Object 變量或未設置塊

Question

我編寫了以下代碼來從網站獲取數據。 一切正常，但是當在工作表（L 列）中收到結果時，出現帶有黃色標記的錯誤 91（代碼中斷）。 但是，當再次按 F5 時，再次在特定列中得到結果，其停止相同的位置。

Sub Pull_Data()
Dim IE As InternetExplorer
Dim doc As HTMLDocument
Dim ElementCol As Object
Dim Link As Object


Dim i As Long
Dim output As Integer
Dim wkb As Workbook

Set wkb = ThisWorkbook

output = 212

Dim ws As Worksheet

Set ws = wkb.ActiveSheet

Set IE = New InternetExplorer

IE.Visible = False

  
        IE.navigate "http://119.40.95.162:8991/Pages/User/ConsumerInfo.aspx"
       
        Do While IE.Busy Or IE.readyState <> READYSTATE_COMPLETE
        Application.Wait Now + TimeValue("00:00:03")
        DoEvents
        Loop
           
      For i = 212 To ws.Range("A55000").End(xlUp).Row
     
        Set doc = IE.document
       
        doc.getElementById("cphMain_txtConsumer").Value = ThisWorkbook.Sheets("H-3").Range("D" & i).Value
       
        doc.getElementById("cphMain_btnReport").Click
       
        Do While IE.Busy Or IE.readyState <> READYSTATE_COMPLETE
        Application.Wait Now + TimeValue("00:00:05")
        DoEvents
        Loop

  With ws

        .Range("L" & i).Value = doc.getElementById("example3").getElementsByTagName("tr").Item(1).getElementsByTagName("td").Item(3).innerText
        .Range("M" & i).Value = doc.getElementById("example3").getElementsByTagName("tr").Item(1).getElementsByTagName("td").Item(5).innerText
        .Range("N" & i).Value = doc.getElementById("example3").getElementsByTagName("tr").Item(1).getElementsByTagName("td").Item(12).innerText
        .Range("O" & i).Value = doc.getElementById("example3").getElementsByTagName("tr").Item(1).getElementsByTagName("td").Item(11).innerText
  End With
             
        Set doc = IE.document
        Set ElementCol = doc.getElementsByTagName("a")
        
       
        For Each Link In ElementCol
            If Link.innerHTML = "Search Again " Then
                Link.Click
            End If
        Next Link
       
       Do While IE.Busy Or IE.readyState <> READYSTATE_COMPLETE
        Application.Wait Now + TimeValue("00:00:03")
        DoEvents
        Loop
       
    Next i


Set IE = Nothing


IE.Quit

NoItems:

End Sub

Answer 1

在大多數情況下，我知道，如果有按 F5 或 F8 不存在的問題，則存在時間問題。 這正是您的代碼所發生的事情。 我會解釋它，因為這是許多web IE 抓取項目中的一個主要錯誤。

您使用以下代碼等待頁面加載：

Do While ie.Busy Or ie.readyState <> READYSTATE_COMPLETE
Application.Wait Now + TimeValue("00:00:03")
DoEvents
Loop

那行得通……但只有一次。 如果 IE 的狀態一旦設置為READYSTATE_COMPLETE ，它將永遠不會被重置，直到代碼結束。 因此，您對上述代碼段的第二次使用不起作用。 循環將立即離開。 該頁面未加載，這就是Runtime Error 91 Object Variable or With block not set的原因。 readyState屬性是只讀的。 所以我們不能手動重置它。

我已經完全重寫了宏。 它從 web 表中讀取所有數據集到 Excel。 （對於每一行，您需要 4 個值。）因此，我假設客戶編號放置在另一張表 (H-3) 中，而不是您需要來自網頁的數據。

如果您使用ActiveSheet作為表格來導入數據，請使用空白表格來查看會發生什么。 第一個導入的行將是工作表中的第一個空行。 因此，您可以使用相同的數據表開始另一個客戶編號列表。

我已將 IE 可見性設置為True ，因此您可以看到頁面訪問時間有多么不同。 當然，您可以隨時將可見性設置為False 。 在開發過程中，我建議您始終使 IE 可見。 這樣您就可以看到正在發生的事情，並且 memory 中沒有 IE 屍體堆積。 例如，使用您問題中的代碼，您可以看到錯誤 91 出現在包含表格的頁面加載之前。

有很多評論。 請仔細閱讀。 我認為你可以學到很多東西：

Sub Pull_Data()

Const url As String = "http://119.40.95.162:8991/Pages/User/ConsumerInfo.aspx"

Dim ie As Object
Dim nodeDataTable As Object
Dim nodeAllDataRows As Object
Dim nodeOneDataRow As Object
Dim nodeDropdown As Object
Dim nodeDate As Object
Dim wkb As Workbook
Dim numberSheet As Worksheet 'Excel sheet with the consumer numbers in column D
Dim dataSheet As Worksheet   'Excel sheet for the wanted data from the internet
Dim currRowNumberSheet As Long
Dim firstRowNumberSheet As Long
Dim lastRowNumberSheet As Long
Dim currRowDataSheet As Long
Dim timeoutStart As Double

  Set wkb = ThisWorkbook
  Set numberSheet = wkb.Sheets("H-3")
  'If you use ActiveSheet as dataSheet you MUST start the makro from from the dataSheet!!!
  'Otherwise the makro will write all data in the real ActiveSheet
  Set dataSheet = wkb.ActiveSheet
  firstRowNumberSheet = 1 '212 'Are you sure that's your first row with a number in column D?
  lastRowNumberSheet = numberSheet.Cells(Rows.Count, 4).End(xlUp).Row 'Last row column D of the numberSheet
  currRowDataSheet = dataSheet.UsedRange.Rows.Count + 1 'Last used row of the dataSheet in general
  
  'Loop over all numbers in column D
  For currRowNumberSheet = firstRowNumberSheet To lastRowNumberSheet
    'Since the IE is a real old diva I recommend to start it new in every loop run
    'This way we have a defined state for each page call
    Set ie = CreateObject("InternetExplorer.Application")
    ie.Visible = False
    ie.navigate url
    'The following line only works one time for an open ie
    'After the readyState is once set to complete there is no reset
    Do While ie.readyState <> 4: DoEvents: Loop
    
    'Place current number from the number sheet to the webpage and click submit button
    ie.document.getElementById("cphMain_txtConsumer").Value = numberSheet.Range("D" & currRowNumberSheet).Value
    ie.document.getElementById("cphMain_btnReport").Click
    
    'Here you must wait to load the page you want, but like I wrote obove, we need another way for the right break
    'Aplication.Wait() is a possibility, but it wastes time in any case because you have to set up a fixed waiting period of time
    'A much more very prettier better way is a loop
    'In those loop we try to catch a HTML element from the page we are waiting for
    'In this way the optimal break is achieved
    'To prevent an endless loop we insert a timeout
    'As the period of time for the timeout you can set the time in seconds you otherwise would use for Aplication.Wait()
    'In most cases this time will never reached
    timeoutStart = Timer
    Do
      'Do the trick by switching off error handling
      On Error Resume Next
      'Try to catch the table with the needed data
      Set nodeDataTable = ie.document.getElementById("example3")
      'Switch back on error handling
      On Error GoTo 0
    'Try again till the table could be catched or till timeout
    Loop While nodeDataTable Is Nothing Or Timer - timeoutStart > 15 'Timeout in seconds
    
    If Not nodeDataTable Is Nothing Then
      'Read data from all rows the whole table:
      'To make this possible, before accessing the table, we manipulate the dropdown responsible for setting the number of rows displayed.
      'If we manually set the number of rows to e.g. 50, this amount of rows will be displayed immediately. This means that there is no
      'further access to the server. All data is already contained in the document. It cannot be seen in the HTML code and there is no JSON.
      'Therefore, I assume that the data is stored in a JavaScript variable.
      '
      'For security reasons, JavaScript variables cannot be accessed from outside. But we have the "Dropdown" interface. If we had an entry
      'showing the maximum number of search hits or more, we would be able to display all rows at once.
      '
      'Attention:
      'With most internet pages, setting the records to be displayed higher only works in the dropdown. But the entry itself has no effect.
      '
      'With this website it works:
      'We change the entry for 100 search hits to be displayed to 10000. If more search hits are needed, this number can simply be increased.
      'Then we select the manipulated entry and read the whole table into the Excel sheet.
      '
      'Let's manipulate the 100 value of the dropdown to 10000
      'Here we don't need to switch off error handling, because we know the right page was loaded
      'Get the right dropdown
      Set nodeDropdown = ie.document.getElementById("example3_length").getElementsByTagName("select")(0)
      'Now select the entry to manipulate
      nodeDropdown.selectedIndex = 3
      'Manipulate it to 10000 (The value. Not the entry to display)
      nodeDropdown.getElementsByTagName("option")(3).Value = 10000
      'To make the entry work we must trigger the change event of the dropdown
      Call TriggerEvent(ie.document, nodeDropdown, "change")
      'Now we need a short periot of time to generate the whole table
      'Since we don't know the HTML code of the last row of the HTML table to use the loop trick, we wait flatly a second
      'That is the price for "immediately", without any knowlage
      Application.Wait (Now + TimeSerial(0, 0, 1))
      'At this point we have the complete table
      'So we can read the data from all rows
      Set nodeAllDataRows = nodeDataTable.getElementsByTagName("tbody")(0).getElementsByTagName("tr")
      For Each nodeOneDataRow In nodeAllDataRows
        With nodeOneDataRow
          dataSheet.Range("L" & currRowDataSheet) = .getElementsByTagName("td")(3).innerText  'Meter Con.
          dataSheet.Range("M" & currRowDataSheet) = .getElementsByTagName("td")(5).innerText  'Consumption (kWh)
          dataSheet.Range("N" & currRowDataSheet) = .getElementsByTagName("td")(12).innerText 'Balance
          Set nodeDate = .getElementsByTagName("td")(11)
          If IsDate(nodeDate.innerText) Then
            dataSheet.Range("O" & currRowDataSheet) = CDate(nodeDate.innerText) 'Pay Date
          Else
            dataSheet.Range("O" & currRowDataSheet) = nodeDate.innerText 'Pay Date
          End If
          currRowDataSheet = currRowDataSheet + 1
        End With
      Next nodeOneDataRow
    Else
      'If there is no data table (e.g. because the customer number is wrong)
      'you should do a notice about that. I do it in the data sheet.
      'I think another place would be better. But I don't know your whole project
      dataSheet.Range("L" & currRowDataSheet) = "No data table"
    End If
    
    'Clean up
    'You must close the IE first since it is a third party application
    'If you first delete the VBA reference to it you can't reach the ie longer from the makro
    ie.Quit
    Set ie = Nothing
    'If you don't set nodeDataTable to Nothing here
    'you will get a 462 (Server not found) in the second loop run
    'The reason is the termination condition of the loop to wait for the data table
    'Without the following line nodeDataTable is never Nothing again after the first
    'loop run, but than the code try to enter data without an object and terminates
    'in the named error in .Range("L" & currRow) = nodeDataTable...
    Set nodeDataTable = Nothing
    
    'Select the last row in the dataSheet. You have an optical feedback while reading data then
    dataSheet.Range("L" & currRowDataSheet).Select
  Next currRowNumberSheet
End Sub

這個 sub() 觸發 HTML 事件：

Private Sub TriggerEvent(htmlDocument As Object, htmlElementWithEvent As Object, eventType As String)

  Dim theEvent As Object

  htmlElementWithEvent.Focus
  Set theEvent = htmlDocument.createEvent("HTMLEvents")
  theEvent.initEvent eventType, True, False
  htmlElementWithEvent.dispatchEvent theEvent
End Sub