CaseA
WScript.echo  "Returned"

Set object = CaseB()
WScript.echo  "Returned"
object = Empty

Set object = CaseC()
WScript.echo  "Returned"
object = Empty

Set object = CaseD()
WScript.echo  "Returned"
object = Empty

CaseE
WScript.echo  "Returned"

CaseF
WScript.echo  "Returned"

WScript.echo  "End of Main"
WScript.echo  "もし、ここ以降でデストラクターが動くときは、"+_
    "プログラム終了時にすべてのオブジェクトを削除する"+_
    "ことによるデストラクター呼び出しです。"


Sub  CaseA()  '// 相互参照しているオブジェクトの削除
    WScript.echo  vbCRLF +"CaseA:"
    Set a_handle = new RootHandleClass       : a_handle.p.Name = "A1"
    Set b_handle = a_handle.p.CreateMember() : b_handle.p.Name = "A2"
    Set a_handle.p.Reference = b_handle.p
    Set b_handle.p.Reference = a_handle.p
End Sub

Function  CaseB()  '// ハンドルを返すとき
    WScript.echo  vbCRLF +"CaseB:"
    Set a_handle = new RootHandleClass       : a_handle.p.Name = "B1"
    Set b_handle = a_handle.p.CreateMember() : b_handle.p.Name = "B2"
    Set a_handle.p.Reference = b_handle.p
    Set b_handle.p.Reference = a_handle.p
    Set CaseB = b_handle
End Function

Function  CaseC()  '// LefeGroup から外れるとき
    WScript.echo  vbCRLF +"CaseC:"
    Set a_handle = new RootHandleClass       : a_handle.p.Name = "C1"
    Set b_handle = a_handle.p.CreateMember() : b_handle.p.Name = "C2"
    Set c_handle = b_handle.p.CreateMember() : c_handle.p.Name = "C3"
    a_handle.p.LifeGroup.Group.Remove  c_handle.p
    Set a_handle.p.Reference = b_handle.p
    Set b_handle.p.Reference = a_handle.p
    Set CaseC = c_handle
End Function

Function  CaseD()  '// ハンドルを複製するとき
    WScript.echo  vbCRLF +"CaseD:"
    Set a_handle = new RootHandleClass       : a_handle.p.Name = "D1"
    Set b_handle = a_handle.p.CreateMember() : b_handle.p.Name = "D2"
    Set a_handle.p.Reference = b_handle.p
    Set b_handle.p.Reference = a_handle.p
    Set CaseD = b_handle.p.GetReference()
End Function

Sub  CaseE()  '// 所属オブジェクトの参照カウンターが 0 から 1 に戻るとき
    WScript.echo  vbCRLF +"CaseE:"
    Set a_handle = new RootHandleClass       : a_handle.p.Name = "E1"
    Set b_handle = a_handle.p.CreateMember() : b_handle.p.Name = "E2"
    Set a_handle.p.Reference = b_handle.p
    Set b_handle.p.Reference = a_handle.p
    b_handle = Empty
    Set b_handle = a_handle.p.GetReference()
End Sub

Sub  CaseF()  '// LefeGroup を再利用するとき
    WScript.echo  vbCRLF +"CaseF:"
    For count = 1  To 2
        Set a_handle = new RootHandleClass       : a_handle.p.Name = "F1"
        Set b_handle = a_handle.p.CreateMember() : b_handle.p.Name = "F2"
        Set a_handle.p.Reference = b_handle.p
        Set b_handle.p.Reference = a_handle.p

        a_handle = Empty
        b_handle = Empty
    Next
End Sub


Class  MemberClass
    Public  Name
    Public  Reference

    Public  LifeGroup  '// Don't write except for LifeGroupClass ■追加

    Private Sub  Class_Terminate()
        WScript.echo  Me.Name +": MemberClass::Class_Terminate"
    End Sub

    Public Sub  DestroyReferences()  '// ■追加
        Me.Reference = Empty
    End Sub

    Public Function  CreateMember()
        Set CreateMember = Me.LifeGroup.Group.Add( new MemberClass )
    End Function

    Public Function  GetReference()
        Set GetReference = Me.LifeGroup.Group.Add( Me.Reference )
    End Function
End Class


Class  LifeGroupCounterClass
    Public  Group
    Public  CreatedMemberID
    Public  ReferenceCount
End Class


Class  RootHandleClass
    Public  p  '// Target object of this handle

    Private Sub  Class_Initialize()
        Set group = new LifeGroupClass
        group.AddHandle  Me, new MemberClass
    End Sub

    Private Sub  Class_Terminate()
        WScript.echo  Me.p.LifeGroup.CreatedMemberID &": RootHandleClass::Class_Terminate"

        If not IsEmpty( Me.p.LifeGroup.Group ) Then _
            Me.p.LifeGroup.Group.AddTerminated  Me.p
    End Sub
End Class


Class  LifeHandleClass
    Public  p  '// Target object of this handle

    Private Sub  Class_Terminate()
        WScript.echo  Me.p.LifeGroup.CreatedMemberID &": LifeHandleClass::Class_Terminate"

        If not IsEmpty( Me.p.LifeGroup.Group ) Then _
            Me.p.LifeGroup.Group.AddTerminated  Me.p
    End Sub
End Class


Class  LifeGroupClass
    Public   Name
    Public   Objects
    Public   TerminatedObjects
    Private  m_CreatedMemberID

    Private Sub  Class_Initialize()
        Set Me.Objects = CreateObject( "Scripting.Dictionary" )
        Set Me.TerminatedObjects = CreateObject( "Scripting.Dictionary" )
        m_CreatedMemberID = 0
    End Sub

    Private Sub  Class_Terminate()
        WScript.echo  "LifeGroupClass::Class_Terminate"
    End Sub

    Public Sub  AddHandle( Handle, Object )
        If IsEmpty( Object.LifeGroup ) Then _
            Set Object.LifeGroup = new LifeGroupCounterClass

        If not IsEmpty( Object.LifeGroup.Group ) Then
            If not Object.LifeGroup.Group Is Me Then
                Err.Raise  1, "すでに別の LifeGroup に所属しているようです"
            End If

            If Object.LifeGroup.ReferenceCount = 0 Then
                Me.TerminatedObjects.Remove  Object.LifeGroup.CreatedMemberID
            End If
            Object.LifeGroup.ReferenceCount = Object.LifeGroup.ReferenceCount + 1
        Else
            Do
                m_CreatedMemberID = m_CreatedMemberID + 1
                If not Objects.Exists( m_CreatedMemberID ) Then _
                    Exit Do
            Loop

            Set Me.Objects( m_CreatedMemberID ) = Object
            Set Object.LifeGroup.Group = Me

            Object.LifeGroup.CreatedMemberID = m_CreatedMemberID
            Object.LifeGroup.ReferenceCount = 1
        End If

        Set Handle.p = Object
    End Sub

    Public Function  Add( Object )
        Set Add = new LifeHandleClass
        Me.AddHandle  Add, Object
    End Function

    Public Sub  Remove( Object )
        If not Object.LifeGroup.Group Is Me Then  Exit Sub
        If not Me.Objects( Object.LifeGroup.CreatedMemberID ) Is Object Then  Exit Sub

        Object.DestroyReferences

        Me.Objects.Remove  Object.LifeGroup.CreatedMemberID
        Object.LifeGroup.Group = Empty
        Object.LifeGroup.CreatedMemberID = Empty
    End Sub

    Public Sub  AddTerminated( Object )
        If not Object.LifeGroup.Group Is Me Then  Exit Sub
        If not Me.Objects( Object.LifeGroup.CreatedMemberID ) Is Object Then  Exit Sub

        Object.LifeGroup.ReferenceCount = Object.LifeGroup.ReferenceCount - 1

        If Object.LifeGroup.ReferenceCount = 0 Then
            Set Me.TerminatedObjects( Object.LifeGroup.CreatedMemberID ) = Object

            If Me.TerminatedObjects.Count = Me.Objects.Count Then
                For Each  a_object  In Me.Objects.Items
                    a_object.DestroyReferences
                    a_object.LifeGroup = Empty
                Next
                Me.Objects.RemoveAll
                Me.TerminatedObjects.RemoveAll
            End If
        End If
    End Sub
End Class

ルート オブジェクトの中にある、相互参照しているオブジェクトのグループとなるオブジェクト。
グループに所属しているオブジェクト（ルート オブジェクトも含む）のハンドルがすべて参照され
なくなったら、相互参照を切るメソッド DestroyReferences を呼び出し、Class_Terminate が
呼び出されます。
ハンドルのメンバー p を介してオブジェクトを操作する必要があります。

CaseA
WScript.echo  "Returned"

Set object = CaseB()
WScript.echo  "Returned"
object = Empty

Set object = CaseC()
WScript.echo  "Returned"
object = Empty

CaseD
WScript.echo  "Returned"

WScript.echo  "End of Main"
WScript.echo  "もし、ここ以降でデストラクターが動くときは、"+_
    "プログラム終了時にすべてのオブジェクトを削除する"+_
    "ことによるデストラクター呼び出しです。"


Sub  CaseA()  '// 相互参照しているオブジェクトの削除
    WScript.echo  vbCRLF +"CaseA:"
    Set group = new LifeGroupClass : group.Name = "CaseA"
    Set a_handle = group.Add( new MutualClass ) : a_handle.p.Name = "A1"
    Set b_handle = group.Add( new MutualClass ) : b_handle.p.Name = "A2"
    Set a_handle.p.Reference = b_handle.p
    Set b_handle.p.Reference = a_handle.p
End Sub

Function  CaseB()  '// ハンドルを返すとき
    WScript.echo  vbCRLF +"CaseB:"
    Set group = new LifeGroupClass : group.Name = "CaseB"
    Set a_handle = group.Add( new MutualClass ) : a_handle.p.Name = "B1"
    Set b_handle = group.Add( new MutualClass ) : b_handle.p.Name = "B2"
    Set a_handle.p.Reference = b_handle.p
    Set b_handle.p.Reference = a_handle.p
    Set CaseB = a_handle
End Function

Function  CaseC()  '// LefeGroup から外れるとき
    WScript.echo  vbCRLF +"CaseC:"
    Set group = new LifeGroupClass : group.Name = "CaseC"
    Set a_handle = group.Add( new MutualClass ) : a_handle.p.Name = "C1"
    Set b_handle = group.Add( new MutualClass ) : b_handle.p.Name = "C2"
    Set c_handle = group.Add( new MutualClass ) : c_handle.p.Name = "C3"
    group.Remove  c_handle.p
    Set a_handle.p.Reference = b_handle.p
    Set b_handle.p.Reference = a_handle.p
    Set CaseC = c_handle
End Function

Sub  CaseD()  '// LefeGroup を再利用するとき
    WScript.echo  vbCRLF +"CaseD:"
    Set group = new LifeGroupClass : group.Name = "CaseD"
    For count = 1  To 2
        Set a_handle = group.Add( new MutualClass ) : a_handle.p.Name = "D1"
        Set b_handle = group.Add( new MutualClass ) : b_handle.p.Name = "D2"
        Set a_handle.p.Reference = b_handle.p
        Set b_handle.p.Reference = a_handle.p

        a_handle = Empty
        b_handle = Empty
    Next
End Sub


Class  MutualClass
    Public  Name
    Public  Reference

    Public  LifeGroup          '// Don't write except for LifeGroupClass
    Public  LifeGroupMemberID  '// Don't write except for LifeGroupClass

    Private Sub  Class_Terminate()
        WScript.echo  Me.Name +": MutualClass::Class_Terminate"
    End Sub

    Public Sub  DestroyReferences()
        Me.Reference = Empty
    End Sub
End Class


Class  LifeHandleClass
    Public  p  '// Target object of this handle

    Private Sub  Class_Terminate()
        WScript.echo  Me.p.LifeGroupMemberID &": LifeHandleClass::Class_Terminate"

        If not IsEmpty( Me.p.LifeGroup ) Then _
            Me.p.LifeGroup.AddTerminated  Me.p
    End Sub
End Class


Class  LifeGroupClass
    Public   Name
    Public   Objects
    Public   TerminatedObjects
    Private  m_CreatedMemberID

    Private Sub  Class_Initialize()
        Set Me.Objects = CreateObject( "Scripting.Dictionary" )
        Set Me.TerminatedObjects = CreateObject( "Scripting.Dictionary" )
        m_CreatedMemberID = 0
    End Sub

    Private Sub  Class_Terminate()
        WScript.echo  "LifeGroupClass::Class_Terminate"
    End Sub

    Public Function  Add( Object )
        If not IsEmpty( Object.LifeGroup ) Then
            If Object.LifeGroup Is Me Then  Set Add = Nothing : Exit Function
            Err.Raise  1, "すでに別の LifeGroup に所属しているようです"
        End If

        Do
            m_CreatedMemberID = m_CreatedMemberID + 1
            If not Objects.Exists( m_CreatedMemberID ) Then _
                Exit Do
        Loop

        Set Me.Objects( m_CreatedMemberID ) = Object
        Set Object.LifeGroup = Me
        Object.LifeGroupMemberID = m_CreatedMemberID

        Set Add = new LifeHandleClass
        Set Add.p = Object
    End Function

    Public Sub  Remove( Object )
        If not Object.LifeGroup Is Me Then  Exit Sub
        If not Me.Objects( Object.LifeGroupMemberID ) Is Object Then  Exit Sub

        Object.DestroyReferences

        Me.Objects.Remove  m_CreatedMemberID
        Object.LifeGroup = Empty
        Object.LifeGroupMemberID = Empty
    End Sub

    Public Sub  AddTerminated( Object )
        If not Object.LifeGroup Is Me Then  Exit Sub
        If not Me.Objects( Object.LifeGroupMemberID ) Is Object Then  Exit Sub

        Set Me.TerminatedObjects( Object.LifeGroupMemberID ) = Object

        If Me.TerminatedObjects.Count = Me.Objects.Count Then
            For Each  a_object  In Me.Objects.Items
                a_object.DestroyReferences
                a_object.LifeGroup = Empty
                a_object.LifeGroupMemberID = Empty
            Next
            Me.Objects.RemoveAll
            Me.TerminatedObjects.RemoveAll
        End If
    End Sub
End Class

相互参照しているオブジェクトのグループとなるオブジェクト。
グループに所属しているオブジェクトのハンドルがすべて参照されなくなったら、
相互参照を切るメソッド DestroyReferences を呼び出し、Class_Terminate が呼び出されます。
ハンドルのメンバー p を介してオブジェクトを操作する必要があります。

Case4
WScript.echo  "End of Main"
WScript.echo  "もし、ここ以降でデストラクターが動くときは、"+_
    "プログラム終了時にすべてのオブジェクトを削除する"+_
    "ことによるデストラクター呼び出しです。"

Sub  Case4()
    WScript.echo  "Case4:"
    Set a_object = new A_Class : a_object.CaseName = "Case4"
    Set b_object = new B_Class : b_object.CaseName = "Case4"
    Set a_object.Reference = b_object
    Set b_object.Reference = a_object.Body  '// ここが a_object では呼び出されなくなる
End Sub


Class  A_Class
    Public  Body

    Private Sub  Class_Initialize()
        Set Me.Body = new A_BodyClass
    End Sub

    Private Sub  Class_Terminate()
        Me.Body.Reference = Empty
    End Sub

    Public Property Get  CaseName() : CaseName = Body.CaseName : End Property
    Public Property Let  CaseName( x ) : Body.CaseName = x : End Property

    Public Property Get  Reference() : Set Reference = Body.Reference : End Property
    Public Property Set  Reference( x ) : Set Body.Reference = x : End Property
End Class

Class  A_BodyClass
    Public  CaseName
    Public  Reference

    Private Sub  Class_Terminate()
        WScript.echo  Me.CaseName +": A_Class::Class_Terminate"
    End Sub
End Class

Class  B_Class
    Public  CaseName
    Public  Reference

    Private Sub  Class_Terminate()
        WScript.echo  Me.CaseName +": B_Class::Class_Terminate"
    End Sub
End Class

検証コード

相互参照しているオブジェクトが、Class_Terminate を呼び出せるようにしたクラス。
このクラスのオブジェクトが削除されたとき、相互参照しているオブジェクトも削除される。

Case1
WScript.echo  "End of Main"
Case2
WScript.echo  "End of Main"
WScript.echo  "もし、ここ以降でデストラクターが動くときは、"+_
    "プログラム終了時にすべてのオブジェクトを削除する"+_
    "ことによるデストラクター呼び出しです。"

Sub  Case1()
    WScript.echo  vbCRLF +"Case1:"
    Set destroyer = new DestroyerClass
    Set a_object = new A_Class : a_object.CaseName = "Case1" : destroyer.Add  a_object
    Set b_object = new B_Class : b_object.CaseName = "Case1" : destroyer.Add  b_object
    Set a_object.Reference = b_object
    Set b_object.Reference = a_object
End Sub

Sub  Case2()
    WScript.echo  vbCRLF +"Case2:"
    Set destroyer = new DestroyerClass
    Set a_object = new A_Class : a_object.CaseName = "Case2"
    Set b_object = new B_Class : b_object.CaseName = "Case2"
    Set a_object.Reference = b_object
    Set b_object.Reference = a_object
End Sub


Class  DestroyerClass
    Public  Objects

    Private Sub  Class_Initialize()
        Set Me.Objects = new ObjectSetClass
    End Sub

    Private Sub  Class_Terminate()
        WScript.echo  "DestroyerClass::Class_Terminate"
        For Each  item  In Me.Objects.Objects.Items
            item.DestroyReferences
        Next
    End Sub

    Public Sub  Add( Object )
        Me.Objects.Add  Object
        Object.IsDestroyer = True
    End Sub

    Public Sub  Remove( Object )
        Me.Objects.Remove  Object
        Object.IsDestroyer = False
    End Sub
End Class

Sub  CheckUnderDestroyer( Object )
    If not Object.IsDestroyer Then _
        Err.Raise 1,, "このオブジェクトは相互参照しているため、DestroyerClass の管理下に置く必要があります。"
End Sub


Class  A_Class
    Public  CaseName
    Public  Reference
    Public  IsDestroyer    '// ■追加

    Private Sub  Class_Terminate()
        WScript.echo  Me.CaseName +": A_Class::Class_Terminate"
        CheckUnderDestroyer  Me  '// ■追加
    End Sub

    Public Sub  DestroyReferences()  '// ■追加
        Me.Reference = Empty
    End Sub
End Class

Class  B_Class
    Public  CaseName
    Public  Reference
    Public  IsDestroyer    '// ■追加

    Private Sub  Class_Terminate()
        WScript.echo  Me.CaseName +": B_Class::Class_Terminate"
        CheckUnderDestroyer  Me  '// ■追加
    End Sub

    Public Sub  DestroyReferences()  '// ■追加
        Me.Reference = Empty
    End Sub
End Class


Class  ObjectSetClass
    Public   Objects
    Private  m_NextID

    Private Sub  Class_Initialize()
        Set Me.Objects = CreateObject( "Scripting.Dictionary" )
        m_NextID = 0
    End Sub

    Public Sub  Add( Object )
        For Each  item  In Me.Objects.Items
            If item is Object Then  Exit Sub
        Next

        Do
            m_NextID = m_NextID + 1
            If not Objects.Exists( CStr( m_NextID ) ) Then _
                Exit Do
        Loop
        Set Me.Objects( CStr( m_NextID ) ) = Object
    End Sub

    Public Sub  Remove( Object )
        For Each  key  In Me.Objects.Keys
            If Objects( key ) is Object Then
                Me.Objects.Remove  key
                Exit Sub
            End If
        Next
    End Sub
End Class

相互参照しているオブジェクトを削除するタイミングを制御するオブジェクト。
DestroyerClass のオブジェクトが削除されるときに、相互参照を切るメソッド DestroyReferences
を呼び出し、Class_Terminate が呼び出されます。

検証コード