'***************************************
' Code for listing all the currently logged-on users.
'***************************************
Public Const JET_SCHEMA_USERROSTER = "{947bb102-5d43-11d1-bdbf-00c04fb92675}"

Public Sub WhosOn()
    ‘Print the details of all currently logged-on users
    Dim rs As ADODB.Recordset
    Dim fld As ADODB.Field
    
    ‘Create the recordset
    Set rs = CurrentProject.Connection.OpenSchema( _
            adSchemaProviderSpecific, , JET_SCHEMA_USERROSTER)
    
    ‘Loop through the recordset
    Do Until rs.EOF
        For Each fld In rs.Fields
            ‘Loop through the Fields collection
            Debug.Print fld.Name
            Debug.Print vbTab & Nz(fld.Value, "-NULL-")
        Next fld
        
        rs.MoveNext
    Loop
    
    ‘Clean up
    rs.Close
    Set fld = Nothing
    Set rs = Nothing
End Sub