This is how I handle determining who is currently logged into my database. One of the things my databases does at startup is to check to see if the local computer is registered (searches table for its computer name). It it's not registered, then I popup a form and ask the user to enter the name and phone and office location of the primary user of the pc. Then I store this info in a table along with the name of the computer. Then I force every user to login to my database (Access Security). Now if want to know who's using my database, I can run the function below and match the names found to my table. Consequently, I know who's using my database, where they are located, and their phone number. (Obviously, this is not full proof since a user could log onto another machine that he/she is not registered with, but...).
This function will tell you who's logged on:
'+***************************************************************************************
'*
'* Sub: WhosLoggedOn
'*
'* Author: FancyPrairie
'*
'* Date: December, 2001
'*
'* Function: This routine will determine who is logged on the the database specified
'* by the caller (generally it should be the Workgroup database).
'*
'* This routine will return the following info in the Recordset passed by
'* the Caller:
'*
'* rst.Fields(0).Name = "Computer_Name" (Char: Name of the computer)
'* rst.Fields(1).Name = "LOGIN_NAME" (Char: Name of user whos logged in)
'* rst.Fields(2).Name = "CONNECTED" (Boolean: True if Connected)
'* rst.Fields(3).Name = "SUSPECT_STATE" (Integer: Null if not suspect)
'*
'* Arguments: strWorkgroup (string)
'* ---------------------
'* This string contains the path (and name) of the database you want to
'* see who's logged in. Usually you would check the workgroup file.
'* (Example: "\\server\ShareName\TheWorkgroup.mdw"
'*
'* rst (ADODB.Recordset)
'* ---------------------
'* This recordset will be returned to the caller. It will contain the
'* names of the computers that are logged on to "strWorkgroup" (see the
'* description of the recordset above).
'*
'* NOTE: This routine will create the recordset and populate it.
'*
'* varSortField (variant - Optional)
'* ---------------------------------
'* This variable indicates which field you want the recordset sorted by.
'* If this argument is not passed, the recordset will not be sorted. The
'* possible values for this variable are:
'* -1 = Don't sort the data
'* 0 = Sort by rst.Fields(0) (Computer_Name) (DEFAULT)
'* 1 = Sort by rst.Fields(1) (Login_Name)
'* 2 = Sort by rst.Fields(2) (Connected)
'* 3 = Sort by rst.Fields(3) (Suspect)
'*
'* varAscDesc (variant - Optional)
'* -------------------------------
'* Indicates how the data is to be sorted. The 2 possible values are:
'* "ASC" = Sort Ascending (DEFAULT)
'* "DESC" = Sort Descending
'*
'* Example: The following is an example of how to call this routine. The call shown
'* will return all of the computers logged on to "\\server\ShareName\TheWorkgroup.mdw"
'* and sorted by "Computer_Name" in Ascending order.
'*
'* Dim rst As ADODB.Recordset
'*
'* Call WhosLoggedOn("\\server\ShareName\TheWorkgroup.mdw", rst)
'*
'+***************************************************************************************
CODE
Option Compare Database
Option Explicit
Public Sub WhosLoggedOn(strWorkgroup As String, _
rst As ADODB.Recordset, _
Optional varSortField As Variant = 0, _
Optional varAscDesc As Variant = "Asc")
'********************************
'* Declaration Specifications *
'********************************
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
On Error GoTo ErrHandler
'*************************
'* Open Workgroup file *
'*************************
cn.Provider = "Microsoft.Jet.OLEDB.4.0"
cn.Open "Data Source=" & strWorkgroup
Set rs = cn.OpenSchema(adSchemaProviderSpecific, _
, "{947bb102-5d43-11d1-bdbf-00c04fb92675}")
'*********************************
'* Create Fields for Recordset *
'*********************************
Set rst = New ADODB.Recordset
rst.Fields.Append rs.Fields(0).Name, adVarWChar, 32
rst.Fields.Append rs.Fields(1).Name, adVarWChar, 32
rst.Fields.Append rs.Fields(2).Name, adBoolean
rst.Fields.Append rs.Fields(3).Name, adInteger
'*************************************************************************
'* Loop thru Recordset and add Computer Name, etc. to user's recordset *
'*************************************************************************
rst.Open
While Not rs.EOF
rst.AddNew
If (Not IsNull(rs.Fields(0))) Then rst.Fields(0) = rs.Fields(0)
If (Not IsNull(rs.Fields(1))) Then rst.Fields(1) = rs.Fields(1)
If (Not IsNull(rs.Fields(2))) Then rst.Fields(2) = rs.Fields(2)
If (Not IsNull(rs.Fields(3))) Then rst.Fields(3) = rs.Fields(3)
rst.Update
rs.MoveNext
Wend
If (varSortField <> -1) Then
rst.Sort = rst.Fields(varSortField).Name & " " & varAscDesc
End If
'********************
'* Exit Procedure *
'********************
ExitProcedure:
Set rs = Nothing
Set cn = Nothing
Exit Sub
'****************************
'* Error Recovery Section *
'****************************
ErrHandler:
Err.Raise vbObjectError + 20100, "Error occcurred in function WhosLoggedOn", "Error Number: " & Err.number & vbCrLf & vbCrLf & "Error Description: " & Err.Description
Resume ExitProcedure
End Sub
