Follow along with the video below to see how to install our site as a web app on your home screen.
Note: This feature may not be available in some browsers.
'+***************************************************************************************
'*
'* 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