'************ Begin Function Code ************
Public Function ADOShowUserRosterToString( _ 
 cnnConnection As ADODB.Connection) _
 As String
 ' Comments : Uses the new Jet 4 User Roster to list all
 ' users in the specified database
 ' Parameters: cnnConnection - open ADODB connection to the Jet Database
 ' Returns : String of all users seperated by a new line
 ' Source : Total Visual SourceBook 2000
 '
 Dim rstTmp As New ADODB.Recordset
 Dim strTmp As String
 
 ' This is the value to pass to Jet to get the
 ' user roster back.
 Const cstrJetUserRosterGUID As String = _
  "{947bb102-5d43-11d1-bdbf-00c04fb92675}"

 On Error GoTo PROC_ERR
 
 ' Jet exposes the user roster as a provider-specific schema
 ' rowset. To get Jet to return this, we open a recordset
 ' and pass the special GUID value.
 Set rstTmp = cnnConnection.OpenSchema( _
 adSchemaProviderSpecific, , cstrJetUserRosterGUID)
 ' The recorset contains four fields:
 ' COMPUTER_NAME: the machine name of the user's computer
 ' LOGIN_NAME : the name the user logged into Access with
 ' CONNECTED : True if the user is still connected
 ' SUSPECT_STATE: Connection was terminated normally or not (generally      
 returns nothing
 ' if the user terminated normally or is still in the database)
 '
 With rstTmp
  Do Until .EOF
   strTmp = strTmp & _
    .Fields(0).Name & ":" & Trim(.Fields(0).Value) & ", " & _
    .Fields(1).Name & ":" & Trim(.Fields(1).Value) & ", " & _
    .Fields(2).Name & ":" & Trim(.Fields(2).Value) & ", " & _
    .Fields(3).Name & ":" & Trim(.Fields(3).Value) & vbCrLf
   .MoveNext
  Loop
 End With
 
 rstTmp.Close
 
 ADOShowUserRosterToString = strTmp

PROC_EXIT:
 Exit Function

PROC_ERR:
 MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
  "ADOShowUserRosterToString"
 Resume PROC_EXIT
End Function
'************ End Function Code ************


'************ Begin Example Code ************
' To call the above function, all you need to do is open 
' connection to the database. This example code will 
' show the connection you create in code here, as well as
' any other users in the database.

 Dim cn As ADODB.Connection
 Set cn = New ADODB.Connection
 ' Open the connection
 With cn
   .CursorLocation = adUseServer
   .Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
      "Data Source=C:\Northwind.mdb"
 End With

  'Example code for ADOShowUserRosterToString
  Debug.Print ADOShowUserRosterToString(cn)
'************ End Example Code ************"