Public Function RefCount(ByVal obj As Object) As Long
 'Возвращает -1, если параметр равен Nothing;
 '            0, если параметр - экземпляр объекта, который будет автоматически
 '               уничтожен (как предполагаеЦЦа) сразу после вычисления выражения,
 '               в котором вычисляется RefCount().
 '   значение>0, если на объект-параметр были ссылки до вычисления выражения,
 '               в котором вычисляется RefCount(). Значение равно количеству
 '               ссылок.
 If obj Is Nothing Then RefCount = -1: Exit Function
 
 Dim Unk As oleexp.IUnknown
 Set Unk = obj
 RefCount = Unk.AddRef - 4
 Unk.Release
End Function

Option Explicit

Private Sub Class_Initialize()
 Debug.Print "Class1 instance initialized"
End Sub

Private Sub Class_Terminate()
 Debug.Print "Class1 instance terminated"
End Sub

Option Explicit

Public Sub Test1()
 Debug.Print "Test1 after start"
 Debug.Print "Before RefCount call"
 Debug.Print "RefCount = " & RefCount(New Class1)
 Debug.Print "After RefCount call"
 Debug.Print "Test1 before end"
End Sub

Public Sub Test2()
 Debug.Print "Test2 after start"
 Debug.Print "Before RefCount call" & vbCrLf & "RefCount = " & _
              RefCount(New Class1) & vbCrLf & "After RefCount call"
 Debug.Print "Test2 before end"
End Sub

Public Sub Test3()
 Debug.Print "Test3 after start"
 Dim rs As Class1
 Debug.Print "After Dim. RefCount = " & RefCount(rs)
 
 Set rs = New Class1
 Debug.Print "After Set New. RefCount = " & RefCount(rs)
 
 With rs
    Debug.Print "After With. RefCount = " & RefCount(rs)
 End With
 
 Debug.Print "After End With. RefCount = " & RefCount(rs)
 
 Set rs = Nothing
 Debug.Print "After Set Nothing. RefCount = " & RefCount(rs)
 Debug.Print "Test3 before end"
End Sub

Public Sub Test4()
 Debug.Print "Test4 after start"
 Dim rs As Class1
 Debug.Print "After Dim. RefCount = " & RefCount(rs)
 
 Set rs = New Class1
 Debug.Print "After Set New. RefCount = " & RefCount(rs)
 
 With rs
    Debug.Print "After With. RefCount = " & RefCount(rs)
 End With
 
 Debug.Print "After End With. RefCount = " & RefCount(rs)
 Debug.Print "Test4 before end"
End Sub