Sample VBA Code for Using the User Roster to Check for Users in a Microsoft Access Database

Sample VBA Code for this Microsoft Access Tip. The code comes from our Total Visual SourceBook product which includes tons of royalty-free code you can include in your database applications.

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
  ' Params  : cnnConnection     Open ADODB connection to the Jet Database
  ' Returns : String of all users seperated by a new line
  ' Source  : Total Visual SourceBook
 
  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 recordset 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 shows 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 ************"

Back to tip: Using the User Roster to Check for Users in a Microsoft Access Database