VBA Outlook：类变量赋值为何运行时正常单步调试异常？

在VBA类嵌套场景中出现异常行为：对象会无理由变为Nothing，且仅在缓慢单步调试时触发，在大型应用中会引发运行时错误（无论是自定义类还是独立Dictionary对象都会出现此问题）。

以下简化代码正常运行时完全正常，但缓慢单步调试时会出现问题。核心问题出在ClsSimpleAgent的PushItem函数中：私有变量ClsSimpleBuffer无法持久化，仅在缓慢单步调试（推测大型应用处理其他任务时也会触发）时出现。

奇怪的现象：

• 无论单步快慢，Locals窗口中作用域内的私有变量this.SimpleBuffer始终显示为Nothing，但作用域内的Public属性SimpleBuffer却正常显示已赋值；
• 对私有变量this.SimpleBuffer添加监视时，其在上下文环境中是已赋值状态。

所有测试均从标准模块过程启动，即使通过模块创建类来运行测试代码，问题仍存在。

标准模块代码 #

Sub simpletest()
Dim i as Integer
Dim agent As ClsSimpleAgent
Dim scrubber As ClsSimpleScrubber

    Set agent = New ClsSimpleAgent

    For i = 1 To 3
    
        agent.PushItem "test " & i
        
    Next i
    
    With New ClsSimpleScrubber: Set scrubber = .Create(agent.SimpleBuffer):  End With
    
    For i = 4 To 6
    
        agent.PushItem "test " & i
        
    Next i
    
    scrubber.PushBuffer agent.SimpleBuffer
    
    scrubber.Scrub
    
    Debug.Print "Done."

End Sub

ClsSimpleAgent类代码 #

Option Explicit
Private Type Tbuffer
'I started with mSimpleBuffer instead of this Private Type - no difference
    SimpleBuffer As ClsSimpleBuffer
End Type

Private this As Tbuffer

Private Sub Class_Initialize()

    Debug.Print "Start Agent up."

End Sub

Private Sub Class_Terminate()

    Debug.Print "Start Agent term."

End Sub

Public Function PushItem(ByVal itemval As String)

    'If I wait anywhere in this function during step through, this.SimpleBuffer acts like it's Nothing _
        if I don't wait, it fails the Is Nothing tests, even though Locals says it's Nothing
        
    If this.SimpleBuffer Is Nothing Then Set this.SimpleBuffer = New ClsSimpleBuffer

    If this.SimpleBuffer Is Nothing Then Debug.Print "this SimpleBuffer is nothing."

    this.SimpleBuffer.PushItem itemval

End Function

Public Property Get SimpleBuffer() As ClsSimpleBuffer

    Set SimpleBuffer = this.SimpleBuffer
    
    Set this.SimpleBuffer = Nothing

End Property

ClsSimpleBuffer类代码 #

Private mBufferDict As Dictionary

Private Sub Class_Initialize()

    Debug.Print "Buffer up."

End Sub

Private Sub Class_Terminate()

    Debug.Print "Buffer term."

End Sub

Public Function PushItem(ByVal itemval As String)

    If mBufferDict Is Nothing Then
    
        Set mBufferDict = New Dictionary
        
    End If
    
    mBufferDict.Add itemval, itemval

End Function

Public Property Get BufferDict() As Dictionary

    Set BufferDict = mBufferDict

End Property

ClsSimpleScrubber类代码 #

Private mSimpleBuffer As ClsSimpleBuffer
Private mBufferColl As New Collection

Private Sub Class_Initialize()

    Debug.Print "Scrubber up."

End Sub

Private Sub Class_Terminate()

    Debug.Print "Scrubber term."

End Sub

Public Function Create(ByRef bufferref As ClsSimpleBuffer)

    If bufferref Is Nothing Then Debug.Print "Scrub.Create gets nothing."
    
    Set mSimpleBuffer = bufferref
    
    mBufferColl.Add mSimpleBuffer
    
    Set Create = Me

End Function

Public Function PushBuffer(ByRef bufferref As ClsSimpleBuffer)

    mBufferColl.Add bufferref

End Function

Public Function Scrub()
Dim i as Integer
Dim buffer As ClsSimpleBuffer

    For Each buffer In mBufferColl
    
        Dim keyval As String: Dim keys As Variant
        
        keys = buffer.BufferDict.keys
        
        With buffer.BufferDict
        
            For i = 0 To .Count - 1
            
                Debug.Print "scrubbing " & .item(keys(i))
                
            Next i
        
        End With
    
    Next

End Function

问题根源 #

核心问题出在ClsSimpleAgent的SimpleBuffer属性获取器中：

Public Property Get SimpleBuffer() As ClsSimpleBuffer

    Set SimpleBuffer = this.SimpleBuffer
    
    Set this.SimpleBuffer = Nothing ' 此行直接清空了私有变量的引用
End Property

当第一次调用agent.SimpleBuffer（即scrubber = .Create(agent.SimpleBuffer)）时，属性返回了缓冲区对象的引用，但同时将agent内部的this.SimpleBuffer设置为Nothing。此时scrubber的集合中持有该缓冲区的引用，对象不会被销毁，但agent内部已经丢失了对该缓冲区的引用。

后续调用agent.PushItem时，this.SimpleBuffer已为Nothing，代码会重新创建一个新的ClsSimpleBuffer实例。缓慢单步调试时，对象生命周期的检查时机变化，使得这个问题更明显地暴露出来。

解决方案 #

移除SimpleBuffer属性获取器中清空私有变量的代码，确保agent内部始终持有缓冲区的引用：

Public Property Get SimpleBuffer() As ClsSimpleBuffer

    Set SimpleBuffer = this.SimpleBuffer
    ' 移除 Set this.SimpleBuffer = Nothing 此行代码
End Property

如果你的设计意图是在获取属性后让agent放弃对缓冲区的引用，需要调整逻辑：例如在PushItem中增加判断，或重新规划对象的生命周期管理，避免出现意外的引用丢失。

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