VBA对象销毁 – 内存错误

我有一个我创build的类对象，其他类的引用（其他类都没有引用）。 我有一个内存问题，当我循环和创build类的实例时，给出了“内存不足”的错误。 类和子例程的简化代码片段如下：

类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窗口中按停止button，内存清除。 有没有什么办法来模仿使用VBA的停止button（如Application.stopmacro或类似的东西）。 或者我在closures对象方面有一个基本问题？ 非常感谢任何见解。

Answer 1

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

一种select是创build你自己的终止方法。

 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）的forms存储。 阅读这篇文章 ，特别是Rob Bruce在评论部分的评论。

 ' 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