Access VBA中使用Set命令替换Collection对象时出现程序无响应问题

从你的描述来看，这个偶发性无响应的问题很典型——和Access单线程模型下的对象回收延迟、UI线程阻塞有直接关系。尤其是"前置耗时代码或暂停就正常"这个现象，说明系统需要一点时间来释放旧的对象引用，或者处理积压的UI消息。下面是针对这个问题的分步解决方案：

1. 彻底清除集合并强制触发垃圾回收 #

直接Set pStNamesRefList = Nothing有时候不会立即销毁集合内的类实例（尤其是类内部有未释放的资源时），逐个移除元素+显式释放+触发UI消息处理会更可靠：

' 先彻底清空集合内的所有元素
If Not pStNamesRefList Is Nothing Then
    Do While pStNamesRefList.Count > 0
        pStNamesRefList.Remove 1 ' 从第一个元素开始移除，避免索引偏移问题
    Loop
    Set pStNamesRefList = Nothing
End If

' 让Access处理积压的UI消息，同时给垃圾回收留时间
DoEvents
' 可选：短暂暂停10毫秒，确保旧对象被完全回收（需要先声明Sleep API）
' Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sleep 10

' 重新初始化集合
Set pStNamesRefList = New Collection

2. 将集合刷新逻辑封装为独立过程，避免UI线程阻塞 #

把刷新代码放到独立模块中，同时禁用UI更新、循环中插入DoEvents，防止长时间操作导致假死：

Public Sub RefreshStreetNamesCollection()
    ' 禁用UI反馈，减少线程阻塞
    Application.Echo False
    Application.ScreenUpdating = False
    
    Dim tempCollection As New Collection
    Dim sSql As String
    Dim DB As DAO.Database
    Dim rs As DAO.Recordset
    Dim node As cStRef
    
    On Error GoTo Cleanup
    
    ' 读取数据填充临时集合
    sSql = "SELECT * FROM [" & Me.dbAccessDatabase4ScrubTables & "].StreetNames WHERE StrNameDirty <> '' ORDER BY StrNameDirty, [Original Oder];"
    Set DB = CurrentDb
    Set rs = DB.OpenRecordset(sSql)
    
    Do While Not rs.EOF
        Set node = New cStRef
        ' 填充类实例属性
        node.StrNameDirty = Nz(rs!StrNameDirty)
        node.StrNameClean = Nz(rs!StrNameClean)
        node.StrNamePreScrub = Nz(rs!StrNamePreScrub)
        node.YesNo = Nz(rs!HasNoStreetType)
        node.word = Nz(rs!Rule)
        node.County = Nz(rs!County)
        node.Action = Nz(rs!Continue)
        
        tempCollection.Add node
        rs.MoveNext
        
        ' 每循环一次就处理UI消息，防止假死
        DoEvents
    Loop
    
    ' 替换旧集合（原子操作，减少操作时间）
    If Not pStNamesRefList Is Nothing Then
        Do While pStNamesRefList.Count > 0
            pStNamesRefList.Remove 1
        Loop
        Set pStNamesRefList = Nothing
    End If
    Set pStNamesRefList = tempCollection

Cleanup:
    ' 显式释放所有数据库对象
    If Not rs Is Nothing Then
        rs.Close
        Set rs = Nothing
    End If
    If Not DB Is Nothing Then Set DB = Nothing
    
    ' 恢复UI状态
    Application.Echo True
    Application.ScreenUpdating = True
    
    ' 错误处理
    If Err.Number <> 0 Then
        MsgBox "集合刷新失败：" & Err.Description, vbCritical
        Err.Clear
    End If
End Sub

3. 检查cStRef类的资源泄漏问题 #

集合中的类实例如果没有正确释放内部资源，会导致引用计数无法归零，垃圾回收无法执行。务必在cStRef的Class_Terminate事件中清理所有内部对象：

' 在cStRef类模块中添加
Private Sub Class_Terminate()
    ' 释放类内部所有对象引用（示例，根据你的类实际情况调整）
    ' If Not m_internalRS Is Nothing Then m_internalRS.Close: Set m_internalRS = Nothing
    ' If Not m_controlRef Is Nothing Then Set m_controlRef = Nothing
End Sub

这个事件只有当类实例的引用计数为0时才会触发，如果有隐式引用（比如窗体控件绑定了类实例），一定要提前解除绑定。

4. 避免多线程/多过程竞争访问集合 #

如果pStNamesRefList是模块级或全局变量，可能存在其他过程同时读取它的情况，导致竞争锁定。可以添加一个简单的锁机制防止并发调用：

' 模块级变量
Private pStNamesRefList As Collection
Private isRefreshing As Boolean

Public Sub RefreshStreetNamesCollection()
    ' 防止重复调用导致冲突
    If isRefreshing Then Exit Sub
    isRefreshing = True
    
    ' ... 中间的刷新逻辑 ...
    
    isRefreshing = False
End Sub

最后排查方向 #

如果以上方法都无效，建议检查：

• 外部数据库链接是否稳定（你的SQL用到了另一个数据库，连接超时可能导致假死）
• Access的信任中心设置，确保数据库被加入信任位置，避免安全机制拦截代码
• 测试时关闭所有其他Office应用，减少系统资源竞争

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