Solve VBA Potentially Massive Memory Leak

So I like object orientation, I also like object models like that of Microsoft Excel.  Excel's object model is very intuitive, you can see the application window, interact with workbooks and worksheets and the cells there.  Analogously, in code, you can navigate the object model from the Application object (normally implied) to the Workbooks collection, to a specific Workbook, then to the Worksheets collection, then to a specific Worksheet and finally a Cells object.  With the Cells object you can finally write code to write to the cell.

The Excel object model is wonderful to navigate, indeed the Excel object model is navigable in both directions as Cells object has a parent property as does the Worksheet, Worksheets, Workbook and Workbooks classes which allows navigation up the chain to the root Application object.

I like to emulate this sort of object model in my own VBA applications but there is a problem here; it is one of circular references and reference counting.  If not careful, this can lead to objects locked in memory and not being destructed.  Imagine a whole elegant rich hierarchy of objects such as that of Excel not being destructed, the memory leak would be massive.

If we have a two-way navigation then a Parent object will have a reference to a Child object and vice versa.  Upon termination of a Child object it is necessary to call a Dispose method on the Child to manually disconnect the Parent, i.e. Set the reference to Parent to Nothing.

(Incidentally this problem is one reason why .NET factored out the IDisposable interface)

Here is our first piece of code which is a Child class

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Child"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private msName As String

Private moParent As Parent '<-- circular reference potential big problem!

Public Property Let Name(ByVal sName As String)
    msName = sName
End Property
Public Property Get Name() As String
    Name = msName
End Property

Public Sub SetParent(ByVal oParent As Parent)
    Set moParent = oParent
End Sub

Public Sub Dispose()
    '* before quitting remove reference to parent to break circular reference
    '* otherwise potential massive memory leak as Parent as Child have a
    '* circular reference where each other stops the other from being
    '* destructed
    Set moParent = Nothing
    '* but this must be called manually, so must be implemented in Parent
    '* class which also must be called manually.  But sometimes people forget!
End Sub

Private Sub Class_Terminate()
    Dispose
End Sub

So you can see the Parent reference being set in the Sub procedure SetParent(). You can also see the Parent reference being cleared in Dispose().

Now let us look at the Parent class

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Parent"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private mcolChildren As New VBA.Collection

Public Sub AddChild(ByVal oChild As Object)
    Call oChild.SetParent(Me)
    
    mcolChildren.Add oChild
End Sub

Public Sub Dispose()
    Dim lLoop As Long
    
    '* loop through in reverse to avoid moving the goal posts re index
    For lLoop = mcolChildren.Count To 1 Step -1
        
        '* need to call Dispose on Child to break any circular reference with Parent
        '* unless using weak references
        mcolChildren.Item(lLoop).Dispose
        
        mcolChildren.Remove lLoop
    Next lLoop
End Sub

Private Sub Class_Terminate()
    '* Sadly putting Dispose() in Class_Terminate won't save you
    '* Class_Terminate only runs when reference count falls to zero
    '* and getting the reference count to zero is what Dispose is meant to do!
    '* you can uncomment and try it if you're skeptical...
    'Dispose
    Debug.Print "Parent Destructor called"
End Sub

You can see the Parent has a Dispose method which should be called when the Parent object is to be destructed. Parent's implementation of Dispose loops through the collection (in reverse so index is well behaved) and calls Dispose on each Child before removing it from the collection. This is the correct and proper way to untangle the circular references BUT it relies upon the client code calling Dispose on the Parent before termination and sometimes programmers forget.

Let us now see some client code, in a standard module paste the following code

Sub TestChildWithDispose()
    
    Dim oParent As Parent
    Set oParent = New Parent

    oParent.AddChild CreateChild("Luke")
    oParent.AddChild CreateChild("Leia")
    
    '* comment out following line to see proof that the
    '* parent's destructor is not called in the case
    '* of circular references
   'oParent.Dispose
    
    Set oParent = Nothing

End Sub

Function CreateChild(ByVal sName As String) As Child
    Dim oChild As Child
    Set oChild = New Child
    oChild.Name = sName
    Set CreateChild = oChild
End Function

You can experiment with the above code by commenting and uncommenting the line that reads "oParent.Dispose" to demonstrate how the Parent Child objects are not destructed unless you call the Parent's Dispose method.

So always ship a Dispose method and make sure it gets called!!!