VBA object destruction - memory error

Question

I have an class object that I create, with references to other classes (none of the other classes reference each other). I am having a memory issue that gives the 'out of memory' error when I loop through and create instances of the class. A simplified code snippet for the class and subroutine follows:

Class 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

Module:

Sub Test1()

Dim zwell As aclsWell

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

End sub

Upon completion of the Test1, excel is using roughly 1 GB of data and if I run again, I get the error message. However, if I hit the stop button in the VBA window the memory clears. Is there any way to mimic hitting the stop button using VBA (such as Application.stopmacro or something similar). Or do I have a fundamental issue in the way I close out the objects? Many thanks for any insight.

Answer 1

It's tricky when you have references going both ways. Your terminate event never fires because the reference count isn't zero when you set your object to Nothing. So you can't clean up your references in the terminate event.

One options is to create your own terminate method.

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

Now when you step through the code your Class_Terminate event will fire because the Terminate method took the reference count down to zero and VBA knew it would be able to clean up the object.

The method I use is to store the memory location of the parent in the child and as a Long (or LongPtr in 64 bit). Read this post and especially Rob Bruce's comment in the comments section.

' 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

Try using End keyword

Sub Test1()

Dim zwell As aclsWell

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

Next i
End
End sub