运行VBA宏循环约5-6次后Excel崩溃关闭问题求助

崩溃核心原因 #

• 循环内反复创建html COM对象但未主动释放，持续积累内存泄漏，多次循环后内存溢出导致Excel崩溃
• 匹配链接时直接将myLink DOM对象赋值给单元格，而非提取其href属性，导致大量未释放的对象残留
• IE页面加载判断逻辑不完整，仅校验readyState未校验Busy状态，容易因页面未完全加载触发未知异常
• 所有对象变量使用完成后未主动置空释放COM引用，持续占用系统资源

修复后可正常运行的代码 #

Sub GetSpecificLinks()
'代码功能：遍历A列的网址，抓取对应站点的联系/投资者关系等指定页面链接，写入对应行的B列

'定义变量
Dim ie As Object 'Internet Explorer对象
Dim html As Object 'HTML文档对象
Dim myLinks As Object '链接集合
Dim myLink As Object '单个链接对象
Dim result As String
Dim myURL As String
Dim LastRow As Long '用Long替代Integer，避免行数超过32767时报错
Dim i As Long

Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = True 'Visible属性只需要设置一次，不用放到循环里重复赋值

LastRow = Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row

For i = 2 To LastRow
    myURL = Sheet1.Cells(i, 1).Value
    ie.navigate myURL
    
    '完善页面加载等待逻辑，同时判断readyState和Busy状态
    While ie.readyState <> 4 Or ie.Busy
        DoEvents
    Wend
    
    result = ie.document.body.innerHTML
    Set html = CreateObject("htmlfile")
    html.body.innerHTML = result

    Set myLinks = html.getElementsByTagName("a")
    For Each myLink In myLinks
        '提取href属性，而非直接赋值对象，同时匹配属性值而非对象本身
        If myLink.href Like "*contact*" Or myLink.href Like "*nquiry*" Or myLink.href Like "*investor*" Or myLink.href Like "*relation*" Then
            Sheet1.Cells(i, "B").Value = myLink.href
            Exit For '匹配到符合要求的链接就退出循环，减少不必要的遍历
        End If
    Next myLink
    
    '每次循环结束主动释放本次创建的对象，避免内存泄漏
    Set myLink = Nothing
    Set myLinks = Nothing
    Set html = Nothing
Next i

'所有循环完成后统一释放IE对象
ie.Quit
Set ie = Nothing

End Sub

额外优化说明 #

• 把行数相关变量从Integer改成Long，避免A列行数超过32767时溢出报错
• IE.Visible属性移出循环，只需要初始化时设置一次即可
• 匹配到符合要求的链接后直接退出内层循环，减少无效遍历提升运行效率
• 把IE退出逻辑移出循环判断，所有循环执行完成后统一退出即可

内容的提问来源于stack exchange，提问作者webportal