On the web you can find some sites (e.g. 1, 2) with functions that allow to find out how many object references are currently keeping a COM object instance alive. This is often useful, for instance if you want to pass an instance to several objects where the last "consumer" is expected to do some cleanup (e.g. call a .Close method ore something the like).

The afforementioned functions read the reference counter at a fixed offset past the object pointer (ObjPtr). This works flawlessly - as long as the object in question is compiled with VB5/6. If, however, you use those functions with a DAO.Database or a VB.Collection, very strange values are likely to be returned. This is not too surprising since the COM specification only demands the functions QueryInterface, AddRef and Release to be implemented, but there is no rule that demands a way to query the reference counter. As far as VB5/6 components are concerned, obviously someone found out by trial & error where this counter is located in memory.

For components written in other programming languages we need a different approach. Here is one that is based on the fact that the COM specification actually does provide a way to read the reference counter, albeit only in an indirect way (thanks to Olaf Schmidt for the hint); regarding IUnknown.AddRef resp. -Release, the MSDN says this:

Return Value
    This method returns the new reference count.
    This value is intended to be used only for test purposes.

So we can read the reference counter by just calling an AddRef-Release-pair and evaluating the return value.

In order for VB to be familiar with the IUnknown interface, we first need to set a reference to Eduardo A. Morcillos OLE interfaces & functions TLB.

Next, we encapsulate the above procedure in the following function:

Public Function GetRefCount(ByVal oToCheck As Object) As Long
Dim UnkToCheck As olelib.IUnknown

  If Not oToCheck Is Nothing Then
    'cast to IUnknown
    Set UnkToCheck = oToCheck
    'increment ref counter
    UnkToCheck.AddRef
    'decrement ref counter and reduce by number of local references
    GetRefCount = UnkToCheck.Release - 3
  End If
End Function

Usage and testing:

Sub Main()
Dim ColInstance As Collection
Dim ColRef2 As Collection, ColRef3 As Collection

  Set ColInstance = New Collection 'instanciate (counter set to 1)
  Set ColRef2 = ColInstance 'add another reference (counter now set to 2)
  Set ColRef3 = ColInstance 'add another reference (counter now set to 3)

  Debug.Print GetRefCount(ColRef3) 'result: 3
End Sub

This function returns the reference count in a reliable way, no matter in what language the component was written originally. However, here we depend on AddRef and Release to really be implemented according to the specification; while in VB this is done automatically for us, it is possible that in other languages the developer failed to set the return values accordingly. So before you use this function in your code, you should test each and every component that you plan to evaluate with it whether it really behaves as expected. Furthermore, this method should only be applied to InProcess-COM-Servers; with OutOfProcess-Servers, "Marshalling" comes into play which means that we no longer can access the "real" reference counter.

Keeping these limitations in mind, this is a pretty helpful tool for debugging also. For instance, with

Debug.Assert GetRefCount(x) = 1
Set x = Nothing

you can make sure that instance x will terminate at this point.

Whenever GetRefCount(x) returns a result different from what you expected, use the expression as a monitoring expression in the IDE; this way you can find out where unwanted additional references are created.

Last not least this method also allows interesting observations: for a DAO.Database, for instance, one should expect the reference counter always to be at least 2, because the Databases-Collection of the Workspace-Objects holds an additional reference to the instance. However, surprisingly this is not the case. So, obviously the Databases-Collection doesn't hold full-blown COM reference pointers but only "weak references".