VBA 对象破坏 - 内存错误

Question

我创建了一个类对象，其中包含对其他类的引用（其他类都没有相互引用）。我有一个内存问题，当我循环并创建类的实例时会出现“内存不足”错误。类和子例程的简化代码 sn-p 如下：

类 aclsWell

Option Explicit
Option Compare Text
Option Base 1

Private zclsSettings As bclsSettings
Private zclsInfo As bclsInfo
Private zclsProduction As bclsProduction

Private Sub Class_Initialize()
 Set zclsSettings = New bclsSettings: Set zclsSettings.Parent = Me
 Set zclsInfo = New bclsInfo: Set zclsInfo.Parent = Me
 Set zclsProduction = New bclsProduction: Set zclsProduction.Parent = Me
End Sub

Private Sub Class_Terminate()
 Set zclsSettings.Parent = Nothing: Set zclsSettings = Nothing
 Set zclsInfo.Parent = Nothing: Set zclsInfo = Nothing
 Set zclsProduction.Parent = Nothing: Set zclsProduction = Nothing
End Sub

模块：

Sub Test1()

Dim zwell As aclsWell

For i = 1 To 2000
    Set zwell = New aclsWell
    Set zWell = Nothing
Next i

End sub

Test1 完成后，excel 正在使用大约 1 GB 的数据，如果我再次运行，我会收到错误消息。但是，如果我在 VBA 窗口中点击停止按钮，内存就会被清除。有什么方法可以模拟使用 VBA 按下停止按钮（例如 Application.stopmacro 或类似的东西）。还是我在关闭对象的方式上存在根本问题？非常感谢您的任何见解。

Answer 1

当您有双向引用时，这很棘手。您的终止事件永远不会触发，因为当您将对象设置为 Nothing 时引用计数不为零。所以你不能在终止事件中清理你的引用。

一种选择是创建自己的终止方法。

Public Sub Terminate()
 Set zclsSettings.Parent = Nothing: Set zclsSettings = Nothing
 Set zclsInfo.Parent = Nothing: Set zclsInfo = Nothing
 Set zclsProduction.Parent = Nothing: Set zclsProduction = Nothing

End Sub

Sub Test1()

Dim zwell As aclsWell
Dim i As Long

For i = 1 To 2000
    Set zwell = New aclsWell
    zwell.Terminate
    Set zwell = Nothing
Next i

End Sub

现在，当您单步执行代码时，您的 Class_Terminate 事件将触发，因为 Terminate 方法将引用计数降至零，并且 VBA 知道它能够清理对象。

我使用的方法是将父级的内存位置存储在子级中并作为 Long（或 64 位的 LongPtr）。 Read this post 尤其是 Rob Bruce 在 cmets 部分的评论。

' In your child class
Private m_lngParentPtr As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
                               (dest As Any, Source As Any, ByVal bytes As Long)

' The Parent property
Public Property Get Parent() As Class1
    Set Parent = ObjFromPtr(m_lngParentPtr)
End Property
Public Property Set Parent(obj As Class1)
    m_lngParentPtr = ObjPtr(obj)
End Property

'Returns an object given its pointer.
'This function reverses the effect of the ObjPtr function.
Private Function ObjFromPtr(ByVal pObj As Long) As Object
    Dim obj                     As Object
    ' force the value of the pointer into the temporary object variable
    CopyMemory obj, pObj, 4
    ' assign to the result (this increments the ref counter)
    Set ObjFromPtr = obj
    ' manually destroy the temporary object variable
    ' (if you omit this step you’ll get a GPF!)
    CopyMemory obj, 0&, 4
End Function

Answer 2

尝试使用End关键字

Sub Test1()

Dim zwell As aclsWell

For i = 1 To 2000
Set zwell = New aclsWell
Set zWell = Nothing

Next i
End
End sub