Who is logged in?

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

I have an Access 2000 split database on a network. The back-end (data) is on
a network drive, and individual copies of the front-end (forms & such) are on
each computer. I would like to make a form for the administrator/manager
that will show who is currently "logged in" to the database.

And if it makes any difference, the database is currently not secure. At all.

Thanks!

Nick
 
Hi, Nick.
I would like to make a form for the administrator/manager
that will show who is currently "logged in" to the database.

One may use the Jet User Roster for checking users logged into the database.
One common usage is to display this information in the Immediate Window.
Please see the following Web page for sample code:

http://support.microsoft.com/default.aspx?id=285822

If you'd like to display the information in a list box on the form instead,
then set a Reference to the ADO library, create a list box with four columns,
name it lstRoster, and create a button, name it UserRosterBtn, then paste the
following code in the form's code module:

Private Sub UserRosterBtn_Click()

On Error GoTo ErrHandler

Dim cnxn As New ADODB.Connection
Dim recSet As New ADODB.Recordset
Dim sCompName As String
Dim sLoginName As String
Dim sList As String
Dim sValue As String
Dim idx As Long
Dim pos As Long

cnxn.Provider = "Microsoft.Jet.OLEDB.4.0"
cnxn.Open "Data Source=T:\Data\MyData.mdb"

' The user roster is exposed as a provider-specific schema rowset
' in the Jet 4 OLE DB provider. You have to use a GUID to
' reference the schema, as provider-specific schemas are not
' listed in ADO's type library for schema rowsets

Set recSet = cnxn.OpenSchema(adSchemaProviderSpecific, , _
"{947bb102-5d43-11d1-bdbf-00c04fb92675}")

'-------------------------------------------------------
' Output the list of all users in the database.
'-------------------------------------------------------
'-------------------------------------------------------
' Get headers for each column in list box.
'-------------------------------------------------------

sList = recSet.Fields(0).Name & ";" & recSet.Fields(1).Name & _
";" & recSet.Fields(2).Name & ";" & recSet.Fields(3).Name

While Not recSet.EOF
'-------------------------------------------------------
' Determine the computer name from Unicode.
'-------------------------------------------------------

sValue = Left(recSet.Fields(0).Value, Len(recSet.Fields(0).Value))

For idx = 1 To Len(sValue)
If (Asc(Mid$(sValue, idx, 1)) = 0) Then
pos = idx
Exit For
End If
Next idx

sCompName = Left(recSet.Fields(0).Value, (pos - 1))
pos = 0
' Reset.

'-------------------------------------------------------
' Determine the login name from Unicode.
'-------------------------------------------------------

sValue = Left(recSet.Fields(1).Value, Len(recSet.Fields(1).Value))

For idx = 1 To Len(sValue)
If (Asc(Mid$(sValue, idx, 1)) = 0) Then
pos = idx
Exit For
End If
Next idx

sLoginName = Left(recSet.Fields(1), (pos - 1))

'-------------------------------------------------------
' Retrieve values for entire row in list box.
'-------------------------------------------------------

sList = sList & ";" & sCompName & ";" & sLoginName & _
";" & recSet.Fields(2) & ";" & _
IIf(IsNull(recSet.Fields(3)), "Null", recSet.Fields(3))
recSet.MoveNext
Wend

Me!lstRoster.RowSource = sList
Me!lstRoster.Requery

CleanUp:

Set recSet = Nothing
Set cnxn = Nothing

Exit Sub

ErrHandler:

MsgBox "Error in UserRosterBtn_Click( ) in " & vbCrLf & _
Me.Name & " form." & vbCrLf & vbCrLf & _
"Error #" & Err.Number & vbCrLf & Err.Description, _
vbExclamation + vbOKOnly, "Error!"

Err.Clear
GoTo CleanUp

End Sub

.. . . and replace T:\Data\MyData.mdb with the path to your database on the
networked server (UNC is preferred), save and compile. At the click of a
button, the user can display all of the users logged into the database on the
server.

HTH.
Gunny

See http://www.QBuilt.com for all your database needs.
See http://www.Access.QBuilt.com for Microsoft Access tips.

(Please remove ZERO_SPAM from my reply E-mail address so that a message will
be forwarded to me.)
- - -
If my answer has helped you, please sign in and answer yes to the question
"Did this post answer your question?" at the bottom of the message, which
adds your question and the answers to the database of answers. Remember that
questions answered the quickest are often from those who have a history of
rewarding the contributors who have taken the time to answer questions
correctly.
 
Holy cow! Gunny, it works flawlessly! This is way beyond what I expected!
Thanks a million!

Nick
 
I use Jet User Roster but failed due to this error "run time error 2147217843
- not a valid password"

Is it due to my BE protected password..If so how to go about it.

TQ
 
Try replacing

cnxn.Provider = "Microsoft.Jet.OLEDB.4.0"
cnxn.Open "Data Source=T:\Data\MyData.mdb"

with

cnxn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=c:\somepath\mydb.mdb;" & _
"Jet OLEDB:Database Password=MyDbPassword"
 
I've followed your instruction but another error msg occured "run time error
424 - object required"

Any idea?
 
cnxn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=c:\somepath\mydb.mdb;" & _
"Jet OLEDB:Database Password=MyDbPassword"
 
Is your declaration

Dim cnxn As New ADODB.Connection

or simply

Dim cnxn As ADODB.Connection

?

If the latter, you need a

Set cnxn = New ADODB.Connection

prior to the .Open method.

If that's not the issue, repost your current code.

(You did, I hope, remember to replace "MyDbPassword" with your actual
password)
 
Here's my code..

Sub ShowUserRosterMultipleUsers()
Dim cn As New ADODB.Connection
Dim cn2 As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim i, j As Long

cnxn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=c:\data\mydb.mdb;" & _
"Jet OLEDB:Database Password=123"

cn2.Open "Provider=Microsoft.Jet.OLEDB.4.0;" _
& "Data Source=c:\data\mydb.mdb;" & _
"Jet OLEDB:Database Password=123"

' The user roster is exposed as a provider-specific schema rowset
' in the Jet 4 OLE DB provider. You have to use a GUID to
' reference the schema, as provider-specific schemas are not
' listed in ADO's type library for schema rowsets

Set rs = cn.OpenSchema(adSchemaProviderSpecific, _
, "{947bb102-5d43-11d1-bdbf-00c04fb92675}")

'Output the list of all users in the current database.

Debug.Print rs.Fields(0).Name, "", rs.Fields(1).Name, _
"", rs.Fields(2).Name, rs.Fields(3).Name

While Not rs.EOF
Debug.Print rs.Fields(0), rs.Fields(1), _
rs.Fields(2), rs.Fields(3)
rs.MoveNext
Wend

End Sub


Appreciate your comment...
 
Why do you have two Connection objects declared? And despite having two
separate Connection objects declared, your code is opening a third
(undeclared) Connection object (you've got cnxn.Open...). You've opened
connection cn2, but you're trying to use cn (which you haven't opened) with
your recordset.

It would appear that you don't have Access set to require variable
declaration: you would have quickly found the fact that you haven't declared
cnxn if you did. While you're in the VB Editor, select Tools | Options, and
ensure that the checkbox "Require Variable Declaration" is checked (on the
Editor tab)
 
Hi,
i'm make form with list box and put code in button (like was describe) but
without response. I click on the button and see network monitor display
activity and after few second stop. List box is without any data and no error
message. What's wrong?
Thanks!

Here is my code:
----------------------------------------
Private Sub UserRosterBtn_Click()

On Error GoTo ErrHandler

Dim cnxn As New ADODB.Connection
Dim recSet As New ADODB.Recordset
Dim sCompName As String
Dim sLoginName As String
Dim sList As String
Dim sValue As String
Dim idx As Long
Dim pos As Long

cnxn.Provider = "Microsoft.Jet.OLEDB.4.0"
cnxn.Open "Data Source=\\Rab\labos baza\Otprema RNR.mdb"

' The user roster is exposed as a provider-specific schema rowset
' in the Jet 4 OLE DB provider. You have to use a GUID to
' reference the schema, as provider-specific schemas are not
' listed in ADO's type library for schema rowsets

Set recSet = cnxn.OpenSchema(adSchemaProviderSpecific, , _
"{947bb102-5d43-11d1-bdbf-00c04fb92675}")

sList = recSet.Fields(0).Name & ";" & recSet.Fields(1).Name & _
";" & recSet.Fields(2).Name & ";" & recSet.Fields(3).Name

While Not recSet.EOF

sValue = Left(recSet.Fields(0).Value, Len(recSet.Fields(0).Value))

For idx = 1 To Len(sValue)
If (Asc(Mid$(sValue, idx, 1)) = 0) Then
pos = idx
Exit For
End If
Next idx

sCompName = Left(recSet.Fields(0).Value, (pos - 1))
pos = 0
' Reset.

sValue = Left(recSet.Fields(1).Value, Len(recSet.Fields(1).Value))

For idx = 1 To Len(sValue)
If (Asc(Mid$(sValue, idx, 1)) = 0) Then
pos = idx
Exit For
End If
Next idx

sLoginName = Left(recSet.Fields(1), (pos - 1))

sList = sList & ";" & sCompName & ";" & sLoginName & _
";" & recSet.Fields(2) & ";" & _
IIf(IsNull(recSet.Fields(3)), "Null", recSet.Fields(3))
recSet.MoveNext
Wend

Me!lstRoster.RowSource = sList
Me!lstRoster.Requery

CleanUp:

Set recSet = Nothing
Set cnxn = Nothing

Exit Sub

ErrHandler:

MsgBox "Error in UserRosterBtn_Click( ) in " & vbCrLf & _
Me.Name & " form." & vbCrLf & vbCrLf & _
"Error #" & Err.Number & vbCrLf & Err.Description, _
vbExclamation + vbOKOnly, "Error!"

Err.Clear
GoTo CleanUp

End Sub
 
I have a similiar need and found this post. I have a split database and want
to see whose logged into the backend. However when I replace
T:\Data\MyData.mdb with the path to my backend db I get an error on the
cnxn.Open statement telling me I don't have the necessary permission to open
the database. I am logged on as the administrator (and creator) of the
database. I'm not sure what I am doing wrong. Any help would be appreciated.
Thanks
 
if you want to be able to do this; then you need to move to SQL Server and
use Access DAta Projects
 
Back
Top