Question

我有一个本地网页列表（超过9000）我想用Excel VBA解析。我使用Office 2013和IE 11：

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的经验也不多，所以我们非常感谢任何帮助。

Answer 1

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

在循环之前放置IE declaration以启动Internet Explorer实例;这是唯一将使用的实例（链接将在此实例中刷新）
set html = Nothing
set ie = Nothing在循环之外，以便只刷新链接而不重新启动IE
ie.Quit仅在解析了所有＆gt; 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

Excel VBA无法加载Internet Explorer

1 个答案: