Excel VBA не загружает Internet Explorer

У меня есть список локальных веб-страниц (более 9000), которые я хочу проанализировать с помощью Excel VBA. Я использую Office 2013 с IE 11:

  • операционная система Windows 7 Enterprise Pro x64, 16 ГБ, i7 – процессор, а также
  • операционная система Windows 8.1 Enterprise x64, 12 ГБ, i7 – процессор

Проблема на обоих машинах заключается в том, что после успешного анализа порядка 70-80 страниц программа внезапно не загружает следующую веб-страницу в IE. Он «застревает», так сказать (см. Комментарий в коде ниже). Если я сброшу программу, тогда после «неудачного» повторения снова можно проанализировать без проблем про 70-80 профилей.

[РЕДАКТИРОВАТЬ: Извините, я по ошибке ошибся с неправильным кодом. Вот исправленная версия]

Вот часть кода:

<!-- language: lang-HTML --> Sub ImportFromWebpage() 'GLOBAL VARIABLES Dim html As HTMLDocument Dim CurrentRowPosition, ProfileNumber, TotalProfiles As Integer Dim TempProfileID As String Dim profileRange, posCounter, currentProfile As Range Set profileRange = Worksheets("List_of_Files").Range("B2:B20000") ProfileNumber = 519 CurrentRowPosition = 520 TotalProfiles = Application.WorksheetFunction.CountA(profileRange) 'MsgBox "TotalProfiles = " & TotalProfiles 'VARIABLES NEEDED FOR PARSING HERE 'ELEMENTS Dim firstIHTMLElmt, secondIHTMLElmt, thirdIHTMLElmt As IHTMLElement Dim firstTempIHTMLElmt, secondTempIHTMLElmt, thirdTempIHTMLElmt, fourthTempIHTMLElmt, fiftTempIHTMLElmt As IHTMLElement 'COLLECTIONS Dim firstIHTMLEColl, secondIHTMLEColl, thirdIHTMLEColl As IHTMLElementCollection Dim firstTempIHTMLEColl, secondTempIHTMLEColl, thirdTempIHTMLEColl, fourthTempIHTMLEColl, fifthTempIHTMLEColl As IHTMLElementCollection Dim ie As InternetExplorerMedium Set ie = New InternetExplorerMedium ie.Visible = False 'FROM HERE LOOPING For startNumber = 1 To TotalProfiles Application.StatusBar = "Loading profile " & ProfileNumber & " from a total of " & TotalProfiles & " profiles" 'Set currentProfile = Worksheets("List_of_Files").Range("J" & CurrentRowPosition) // OLD Set currentProfile = Worksheets("List_of_Files").Range("B" & CurrentRowPosition) ie.navigate currentProfile Application.StatusBar = "Loading profile: " & ProfileNumber & "; file location: " & currentProfile Do While ie.READYSTATE <> READYSTATE_COMPLETE DoEvents Loop Application.StatusBar = "Storing " & currentProfile & " information into HTMLElement" Set html = ie.document Set ie = Nothing [code, code, code, code ...] Application.Wait (Now + TimeValue("0:00:02")) Next startNumber Set html = Nothing ie.Quit Set ie = Nothing MsgBox "Done parsing all profiles!" End Sub 

Вот скриншот из диспетчера задач Windows 8.1 ПОСЛЕ того, как не загружается : введите описание изображения здесь

введите описание изображения здесь

Доза у кого-нибудь есть подсказка, почему это происходит? Не только на одной машине, но и на обоих.

Я не очень хорошо разбираюсь в программировании и даже меньше с VBA, поэтому любая помощь будет высоко оценена.

Это решение оказалось хорошим в моем случае. Не знаю, является ли это лучшим решением, но оно работает очень хорошо для меня.

  • поместите IE declaration перед циклом, чтобы инициировать экземпляр Internet Explorer; это единственный экземпляр, который будет использоваться (ссылка только будет обновлена ​​в этом экземпляре)
  • set html = Nothing внутри цикла
  • set ie = Nothing вне цикла, так что только ссылка может быть обновлена ​​без перезапуска IE
  • ie.Quit только после разбора всех> 9000 веб-страниц (так вне цикла)

Надеюсь, это поможет другим с той же проблемой.

 Sub ImportFromWebpage() 'GLOBAL VARIABLES Dim html As HTMLDocument Dim CurrentRowPosition, ProfileNumber, TotalProfiles As Integer Dim TempProfileID As String Dim profileRange, posCounter, currentProfile As Range Set profileRange = Worksheets("List_of_Files").Range("B2:B20000") ProfileNumber = 1 CurrentRowPosition = 2 TotalProfiles = Application.WorksheetFunction.CountA(profileRange) 'MsgBox "TotalProfiles = " & TotalProfiles Dim ie As InternetExplorerMedium Set ie = New InternetExplorerMedium ie.Visible = False 'FROM HERE LOOPING For startNumber = 1 To TotalProfiles Application.StatusBar = "Loading profile " & ProfileNumber & " from a total of " & TotalProfiles & " profiles" 'Set currentProfile = Worksheets("List_of_Files").Range("J" & CurrentRowPosition) // OLD Set currentProfile = Worksheets("List_of_Files").Range("B" & CurrentRowPosition) ie.navigate currentProfile Application.StatusBar = "Loading profile: " & ProfileNumber & "; file location: " & currentProfile Do While ie.READYSTATE <> READYSTATE_COMPLETE DoEvents Loop Application.StatusBar = "Storing " & currentProfile & " information into HTMLElement" Set html = ie.document [code, code, code, code ...] Set html = Nothing Application.Wait (Now + TimeValue("0:00:02")) Next startNumber Set ie = Nothing ie.Quit MsgBox "Done parsing all profiles!" End Sub 
  • Разбор MS Excel-файла для пользовательского перечисления из объединенного поля
  • Преобразование из двойной строки в String, но сохранение начальных нулей
  • Разбор SQL-файла для разделения столбцов
  • C # Анализ формата пользовательских ячеек Excel
  • Разбор в python, чтобы преуспеть
  • Анализ или извлечение текста из одной ячейки в электронной таблице
  • Анализ данных из файла .txt с использованием VBA, данных и переменных на разных строках
  • Получить суб-части текста в ячейке
  • Импорт необработанного файла определенным образом
  • Datatable - проблема с разбором столбца excel с несколькими форматами
  • Борясь с использованием Python для анализа и управления XML-файлом с содержимым из внешних текстовых файлов
  • Interesting Posts
    Давайте будем гением компьютера.