Active users count

[janith]

Hi,

Is there a way in access which will show me how many users are currently using the db file. This should show up as a form label control property on my form banner?

Any VBA code one can suggest!!

 

[arnelgp]

see this post:http://www.access-programmers.co.uk/forums/showthread.php?t=99822

 

[janith]

I don't think that's a resolved post!!!

 

[arnelgp]

you i know why is that? the code can be found in http://www.fmsinc.com/MicrosoftAccess/monitor/database-users.htm

the record count returns the number of users.

the connection object for MsAccess 2007-2013 can be defined:

With cn
.CursorLocation = adUseServer
.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=Z:\Tmp.accdb"
End With

just replace the Data Source to the path of your DB.

 

[janith]

I'm sorry but I wanted this as a label on the banner... Active users: (count)...

For this label what should be the control source. Just please confirm me the code to be pasted there.

 

[arnelgp]

put this in your form's Open event:

Private intNumberOfUsers as Integer

Private Sub Form_Open(Cancel As Integer)
ShowActiveUserCount
End Sub

Private Sub ShowActiveUserCount()
  Dim cn As ADODB.Connection

  Set cn = New ADODB.Connection

  ' Open the connection
  With cn
    .CursorLocation = adUseServer
    .Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=Z:\Tmp.accdb"
  End With

   intNumberOfUsers  =ADOShowNumberOfUsers(cn)

  Me.yourLabeControl.Caption = "Active Users: " & LTrim(intNumberOfUsers)
End Sub

now paste this code in a Module:

Public Function ADOShowNumberOfUsers(cnnConnection As ADODB.Connection) As Integer
  ' 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)

  ADOShowNumberOfUsers = rstTmp.RecordCount
  rstTmp.Close


PROC_EXIT:
  Exit Function

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

remember the caption of your Label control is not automatically updated when someone uses the db, you must have a timer event on your form that calls ShowActiveUserCount sub for your label control to be updated.

type the correct path to the db you want to monitor in the connection (cn) object Data Source.