IE自动化问题：IE无响应导致Access VBA代码挂起求助

看起来你碰到了IE11在Win7环境下批量处理网页的经典稳定性问题——长时间循环后IE崩溃导致VBA线程被卡死，必须手动杀进程才能恢复。结合你的代码片段和环境配置，我给你几个能直接落地的修复方案：

1. 彻底清理所有IE进程，避免残留 #

IE11采用多进程架构，你的KillProcess可能只杀了主进程，残留的子进程会导致资源泄漏和VBA挂起。替换成更彻底的进程终止逻辑：

Sub KillAllIEProcesses()
    Dim objWMIService As Object
    Dim colProcesses As Object
    Dim objProcess As Object
    
    Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
    Set colProcesses = objWMIService.ExecQuery("SELECT * FROM Win32_Process WHERE Name = 'iexplore.exe'")
    
    For Each objProcess In colProcesses
        objProcess.Terminate()
    Next
    
    Set objProcess = Nothing
    Set colProcesses = Nothing
    Set objWMIService = Nothing
    ' 给系统1秒时间释放资源
    Sleep 1000
    DoEvents
End Sub

之后在超时或检测到挂起时，调用这个函数替代原来的KillProcess，确保所有IE进程都被清理。

2. 优化IE实例的销毁流程，避免内存泄漏 #

每次循环结束或异常退出时，不仅要调用IE.Quit，还要手动释放对象引用，并用小技巧触发VBA的垃圾回收：

' 在退出循环或异常处理时执行
IE.Quit
Set IE = Nothing
' 强制触发VBA垃圾回收（VBA无原生GC，用空对象赋值模拟）
Dim dummyObj As Object
Set dummyObj = CreateObject("Scripting.FileSystemObject")
Set dummyObj = Nothing

另外，不要在超时后直接创建新IE实例，先确保旧进程完全终止，再初始化新实例。

3. 改进挂起检测逻辑，提前发现崩溃的IE #

你的CheckIfIEIsHanging可能不够灵敏，建议通过尝试访问IE属性来判断实例是否存活：

Function CheckIfIEIsHanging(IE As Object) As Boolean
    On Error Resume Next
    ' 尝试访问IE的LocationURL属性，报错则说明实例已崩溃
    Dim testURL As String
    testURL = IE.LocationURL
    CheckIfIEIsHanging = (Err.Number <> 0)
    On Error GoTo 0
End Function

在你的Busy/ReadyState检查循环前，先调用这个函数，提前发现崩溃的IE实例，避免卡在无响应的检查逻辑里。

4. 调整等待逻辑，减少Sleep的阻塞影响 #

Sleep会直接阻塞VBA线程，改用DoEvents结合Timer的方式等待，既能让Access保持响应，又能等待IE状态变化：

StartTime = Timer
Do While True
    DoEvents
    SecondsElapsed = Timer - StartTime
    StatusBar ("Caricamento in corso. Attendi... (Busy " & Round(SecondsElapsed) & " sec)")
    
    ' 先检查IE是否挂起
    If CheckIfIEIsHanging(IE) Then
        Exit Do
    End If
    
    ' 不再忙碌则退出循环
    If Not IE.Busy Then
        Exit Do
    End If
    
    ' 超时处理
    If SecondsElapsed > 20 Then
        Exit Do
    End If
    
    ' 等待200ms，比Sleep更友好
    Dim waitStart As Double
    waitStart = Timer
    Do While Timer - waitStart < 0.2
        DoEvents
    Loop
Loop

这种方式不会让Access完全无响应，用户能看到状态栏的更新，也能及时处理异常。

5. 批量处理后主动休息，缓解IE内存压力 #

Win7下的IE11有明显的内存泄漏问题，建议每处理100条左右的记录，就彻底清理IE进程并让系统休息几秒：

' 在循环内部加入计数逻辑
Static loopCounter As Integer
loopCounter = loopCounter + 1
If loopCounter Mod 100 = 0 Then
    KillAllIEProcesses
    Sleep 3000 ' 休息3秒，让系统释放内存
    Set IE = New SHDocVw.InternetExplorer
    IE.Visible = False
End If

整合优化后的代码片段 #

把上面的优化点整合到你的原有逻辑中，示例如下：

StartTime = Timer
' 检查Busy状态的循环
Do While True
    DoEvents
    SecondsElapsed = (Timer - StartTime)
    StatusBar ("Caricamento in corso. Attendi... (Busy " & Round(SecondsElapsed) & " sec)")
    
    If CheckIfIEIsHanging(IE) Then
        Exit Do
    End If
    
    If Not IE.Busy Then
        Exit Do
    End If
    
    If SecondsElapsed > 20 Then
        Exit Do
    End If
    
    ' 等待200ms
    Dim waitStartBusy As Double
    waitStartBusy = Timer
    Do While Timer - waitStartBusy < 0.2
        DoEvents
    Loop
Loop

' 处理挂起或超时
If CheckIfIEIsHanging(IE) Or SecondsElapsed > 20 Then
    Call Sound
    KillAllIEProcesses
    Set IE = New SHDocVw.InternetExplorer
    IE.Visible = False
    GoTo reload
End If

' 检查ReadyState的循环
StartTime = Timer
Do While True
    DoEvents
    SecondsElapsed = (Timer - StartTime)
    StatusBar ("Caricamento in corso. Attendi... (NotReady " & Round(SecondsElapsed) & " sec)")
    
    If CheckIfIEIsHanging(IE) Then
        Exit Do
    End If
    
    If IE.ReadyState = 4 Then
        Exit Do
    End If
    
    If SecondsElapsed > 20 Then
        Exit Do
    End If
    
    Dim waitStartRS As Double
    waitStartRS = Timer
    Do While Timer - waitStartRS < 0.2
        DoEvents
    Loop
Loop

If CheckIfIEIsHanging(IE) Or SecondsElapsed > 20 Then
    Call Sound
    KillAllIEProcesses
    Set IE = New SHDocVw.InternetExplorer
    IE.Visible = False
    GoTo reload
End If

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