Блог

Я написал приведенный ниже код для получения данных с веб-сайта. Все в порядке, но когда результат получен в листах (столбец 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" amp; 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" amp; i).Value = doc.getElementById("example3").getElementsByTagName("tr").Item(1).getElementsByTagName("td").Item(3).innerText
        .Range("M" amp; i).Value = doc.getElementById("example3").getElementsByTagName("tr").Item(1).getElementsByTagName("td").Item(5).innerText
        .Range("N" amp; i).Value = doc.getElementById("example3").getElementsByTagName("tr").Item(1).getElementsByTagName("td").Item(12).innerText
        .Range("O" amp; 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
 

В большинстве случаев я знаю, что если есть проблемы, которых нет при нажатии F5 или F8, возникает проблема с синхронизацией. Именно это и происходит с вашим кодом. Я объясню это, потому что это серьезная ошибка во многих проектах веб-очистки с IE.

Для ожидания загрузки страницы используется следующий код:

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

Это работает … Но только один раз. Если статус IE однажды установлен READYSTATE_COMPLETE , он никогда не будет сброшен до конца кода. Из-за этого ваше второе использование упомянутого фрагмента кода не работает. Цикл будет немедленно прерван. Страница не была загружена, и это является причиной ошибки среды выполнения 91 объектная переменная или с не установленным блоком. readyState Свойство доступно только для чтения. Поэтому мы не можем сбросить его вручную.

Я полностью переписал макрос. Он считывает все наборы данных из веб-таблицы в Excel. (Для каждой строки 4 желаемых значения.) Из-за этого я предполагаю, что номера клиентов размещены на другом листе (H-3), чем вам нужны данные с веб-страницы.

Если вы используете ActiveSheet as table для импорта данных, используйте пустой лист, чтобы посмотреть, что произойдет. Первая импортированная строка будет первой пустой строкой на листе. Таким образом, вы можете запустить другой список номеров клиентов с той же таблицей данных.

Я установил видимость IE True , чтобы вы могли видеть, насколько отличается время доступа к странице. Вы, конечно, можете установить видимость False в любое время. Во время разработки я советую вам всегда делать IE видимым. Таким образом, вы можете видеть, что происходит, и в памяти не накапливаются трупы 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" amp; 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" amp; currRowDataSheet) = .getElementsByTagName("td")(3).innerText  'Meter Con.
          dataSheet.Range("M" amp; currRowDataSheet) = .getElementsByTagName("td")(5).innerText  'Consumption (kWh)
          dataSheet.Range("N" amp; currRowDataSheet) = .getElementsByTagName("td")(12).innerText 'Balance
          Set nodeDate = .getElementsByTagName("td")(11)
          If IsDate(nodeDate.innerText) Then
            dataSheet.Range("O" amp; currRowDataSheet) = CDate(nodeDate.innerText) 'Pay Date
          Else
            dataSheet.Range("O" amp; 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" amp; 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" amp; currRow) = nodeDataTable...
    Set nodeDataTable = Nothing
    
    'Select the last row in the dataSheet. You have an optical feedback while reading data then
    dataSheet.Range("L" amp; 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