Excel VBA 无法加载 Internet Explorer答案

【问题标题】：Excel VBA fails to load Internet ExplorerExcel VBA 无法加载 Internet Explorer
【发布时间】：2015-12-10 13:22:53
【问题描述】：

我有一个本地网页列表（超过 9000 个），我想用 Excel VBA 对其进行解析。我在 IE 11 上使用 Office 2013：

Windows 7 Enterprise Pro x64、16 GB RAM、i7 - 处理器，但也开启
Windows 8.1 Enterprise x64、12 GB RAM、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 的经验更少，因此非常感谢任何帮助。

【问题讨论】：

前几天我 answered your question 时，我的第一个建议是在循环之前启动 IE 一次，然后在循环中使用相同的浏览器导航到每个页面。为什么不试试呢？我怀疑浏览器并不总是退出（通过查看仍然打开的数量）并且可能会导致您的问题。完成所有处理后，您可以退出 IE。
首先，您为列表中的每个页面创建一个 IE 实例，这样您的计算机就会超载。将该行 Set ie = New InternetExplorerMedium 移出循环并等待解析第一页以导航到新页面，它应该会更好！ ;)
尝试在您的代码中使用 Error Handling Blocks 和 On Error Goto。至少它会帮助您克服创建多个 IE 实例的问题。
如果您要为每个页面创建一个新的 IE 实例，您需要在设置 IE = nothing 之前 .Quit。但是，重用同一个实例要好得多。
更新的代码不正确，因为循环中的Set ie = Nothing 行。使用此代码，循环只会工作一次。唯一的Set ie = Nothing 行应该在宏末尾的ie.Quit 之后

标签： vba excel parsing internet-explorer

【解决方案1】：

在我的情况下，这个解决方案被证明是一个很好的解决方案。不知道这是否是最好的解决方案，但它对我来说非常有用。

将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

【讨论】：