How to determine who is logged on my database? (1 Viewer)

[isetea]

Hi,
I have a sub, which shows in the Intermediate window who is currently logged to the database. This is my code:

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

Set cn = CurrentProject.Connection

' The user roster is exposed as a provider-specific schema rowset
' in the Jet 4.0 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

Now I want to provide this information in a table or other kind of output, when the administrative user presses a button on a form.

What do I have to do with that code?

Can Anybody help me with that?

Thanks in advance...

 

[pdx_man]

Create a listbox on your form (ListUsers). In your While loop add:
ListUsers.AddItem Whateveryouwantdisplayed

 

[isetea]

I don't know, if a list box does it...
Currently the code is showing the follwoing four information:
COMPUTER_NAME, LOGIN_NAME, CONNECTED, SUSPECT_STATE

I more thought about a button, which runs the code and produces an output table or list with the information.

Is there a possibility to get this result somehow?

 

[gemma-the-husky]

I thought the problem with this is that this identifies who is in the active database. However, if you have a split fe/be, then what yuo really want os to know who is using the be database. Can you do that with this?

 

[pdx_man]

Gemma, the cn can be directed at any Access database. That is how I do it. I pass the location of the database that I want to know who the users are, whether it be FE or BE.

I have a form with a listbox (ListUsers) that will then list out the users and a text box where I can put in the path of the DB I want to know about. I also have some buttons for quick references to DBs I need to know about often.
This is how I have modified the code for my use:

Public Function GetCompUserName(strComputer As String) As String

Dim obj As Variant
Dim Object As Variant

Set obj = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2").ExecQuery("Select * FROM Win32_OperatingSystem")
    
    For Each Object In obj
        GetCompUserName = Object.Description
    Next
    If GetCompUserName = "" Then GetCompUserName = "UNKNOWN - " & strComputer
    
End Function

Sub ShowUserRosterMultipleUsers(DBPath As String)
    Dim cn As New ADODB.Connection
    Dim rs As New ADODB.Recordset

    Me.FlagReady.BackColor = vbRed
    Me.ListUsers.BackColor = 12632256
    Me.Repaint

    Set cn = CreateObject("adodb.Connection")
    cn.Provider = "Microsoft.Jet.OLEDB.4.0"
    cn.Open (DBPath)
    ' The user roster is exposed as a provider-specific schema rowset
    ' in the Jet 4.0 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.
    While Not rs.EOF
        If Trim(rs.Fields(0)) <> [i]MyComputer[/i] Then   ' If I am in a database I am looking up, I don't need to know about it.
            ListUsers.AddItem "'" & GetCompUserName(Trim(rs.Fields(0))) & "'"
        End If
        rs.MoveNext
    Wend

    Me.ListUsers.BackColor = 16777215
    Me.FlagReady.BackColor = vbGreen
    Me.Repaint
    
End Sub

 

[isetea]

Ok. I didn't understand everything. I have a button and a list box. I named the list box already ListUsers. But what name gets the command button and what should the button run for code?
Where do I need to place the path for my database?
Maybe you can make it very easy, because I'm a newbie to VBA and still do not understand everything.
Why can I not use the code I first posted? Is there anything I need to modify to get a result in a listbox?
I would appriciate if you can give me a little bit more help. Thanks very much in advance...

 

[gemma-the-husky]

PDX_Man,

what's the correct tools reference for the ADO library - is it available in Access97 (I have all later versions also). I only normally use DAO.

 

[ColinEssex]

You can get current users by using

Environ("username")

Col

 

[gemma-the-husky]

pdx_man posted some code to interrogate the logged in users of any dbs, not the current dbs. It needs ADO, and I was trying to confirm the correct reference to set for ADO.

 

[pdx_man]

isetea, name the command button whatever makes sense to you. I call it PopUsers:

Private Sub PopUsers_Click()

    ListUsers.RowSource = ""
    Call ShowUserRosterMultipleUsers("ThePathToMyDB")
    
End Sub

You can use your code, but what are you looking for? I started with the exact same code and modified it to return only what I was looking for, the Name of the person associated to the computer that is logged into any Access Database. The original code does return other items, as it uses rs.Fields(0), rs.Fields(1), rs.Fields(2), rs.Fields(3), but I only need the contents of rs.Fields(0) as that is the computer that is logged into the DB.

The rs.Fields(1) is only good if your DB has logins, which mine do not. I am not sure about the value of fields 2 & 3.

To have a Browse button to dynamically specify a DB to check:

Private Sub BrowseBut_Click()
Dim dlgOpen As FileDialog
On Error GoTo Handle5

    Set dlgOpen = Application.FileDialog(msoFileDialogOpen)
    
    With dlgOpen
        .AllowMultiSelect = False
        .FilterIndex = 2
        .Show
    End With
    
    Me.FilePath = dlgOpen.SelectedItems(1)

    Exit Sub
Handle5:
    If Err.Number = 5 Then Exit Sub
End Sub

So, I have an unbound text box on the form named FilePath where it gets populated by either typing the path in, or clicking on a Browse ... button to get populated. Next to it, I have another button named GetDynam that calls the routine with the path found in the FilePath text box.

Private Sub GetDynam_Click()

    ListUsers.RowSource = ""
    Call ShowUserRosterMultipleUsers(Me.FilePath)

End Sub

Gemma, for references, I am using the Microsoft ActiveX Data Objects 2.5 Library.

Col, this is to determine all users who are logged into either the current DB or any other DB in your domain.

BTW, I also have another button that will create an email to all of the users found that I then add whatever message and send it. I am confident there is enough postings on this forum regarding sending emails from Access that I don't have to cover that one.

 

[rahulgty]

I use to solve this problem in my multiusers application, by a login form. In starting I allot him a user name and a pass word. which he can change later but he can not change the his ID no ( how ever ID No is a auto numbered field and user is not aware about that). So the ID no remain same, user only can edit his username and pass word. when ever he logged on any computer on network, his id, present user name, terminal name/no, login time, logoff time recorded in a table on a seperate hidden database on server. So when ever administrater want he can view that table (or a report based on that table). If you need I can send you that code.

Rahul

 

[isetea]

Thanks for all the good replies. Probably I should give you more information about what I have and what I want to have
I have a secured database for multi-user access. The user will always open my database from a shortcut, which contains executable application, database-path and workgroup-path. I want to have either an output in a table or in report (or somehting else, if there is more in space out there...) what user are currently logged on. The code I use in VBA provides me with the terminal ID, the user loggon name, a status if the user is logged on (which I do not really need) and a status, if the log out was corrupt in any way (which I also not need necessarily). The superuser of this database is not that familiar with VBA and I want him not to use the Modul to see who is logged on, but a fancy button on a fancy form. Also a send email function is a very good idea indeed (thanx... )
The very thing is, I read a hell lot about security in this forum, user access, loggon etc. etc. I got some good ideas, but they often start at I point I haven't reach with my access knowledge yet. I learned everything by myself, the usernet and Allison Balter (as far as she goes). Unfortunately, pieces of code always take me a long time to understand how I can create a full working process. That's why I'm asking for more like a step-by-step-doing and which-preconditions-are-necessary(libraries e.g.) help
Hope this explains a little bit the trouble I'm in.

 

[isetea]

Currently I have a command button called PopUsers with that code

Private Sub PopUsers_Click()

ListUsers.RowSource = ""
Call ShowUserRosterMultipleUsers("M:\PBS Wealth Management\Head office\Operations\Staff Database\PBS - Wealth Management Staff DB")

End Sub

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

Set cn = CurrentProject.Connection

' The user roster is exposed as a provider-specific schema rowset
' in the Jet 4.0 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

And a list box called ListUsers.

When I press the button the error message: "Compile error: Wrong number of arguments or invalid property assignment." occurs.

I have the Microsoft ADO Ext.2.7 for DDL and Security library on.

Any idea what is worng or maybe I'm completly on the wrong path... ???? :?

 

[pdx_man]

I'm running out the door, but it the path does need to be fully qualified with the extension, too.

Call ShowUserRosterMultipleUsers("M:\PBS Wealth Management\Head office\Operations\Staff Database\PBS - Wealth Management Staff DB.mdb")

Also, you need to populate your listbox

While Not rs.EOF
Debug.Print rs.Fields(0), rs.Fields(1), _
rs.Fields(2), rs.Fields(3)
ListUsers.AddItem "'" & rs.Fields(0) & " - " & rs.Fields(1) & "'"
rs.MoveNext
Wend

Gemma, for references, I am using the Microsoft ActiveX Data Objects 2.5 Library.

 

[isetea]

When I press the button PopUsers I still get the message "Compile error: Wrong number of arguments or invalid property assignment." occurs. It is exactly claiming the "Call ShowUserRosterMultipleUsers" method. What did I wrong? Please help...

 

[isetea]

Please can anybody help me I got only two days left to finish this. Thanks very much

 

[pdx_man]

Hello, I was in Vegas for a few days.

Have you tried stepping through your code? On what line do you get this error?

Try this:

Private Sub PopUsers_Click()
Dim TheFile As String

ListUsers.RowSource = ""
TheFile = "M:\PBS Wealth Management\Head office\Operations\Staff Database\PBS - Wealth Management Staff DB"
debug.print TheFile
Call ShowUserRosterMultipleUsers(TheFile)

Copy the string in the Debug (Immediate) window to Windows Explorer and hit enter. Does it open the database OK? If not, then you have an issue with the path to the file.

 

[isetea]

Hi pdx man,
you lost me a bit with your last post. Where exactly should I enter which code?
The Database path is correct. But the database I'm referring to is secured. Maybe thats a problem?
The error message pops up before my debugger works. When I press the button PopUsers it immediatly jumps into the VB Window ans points to the Private Sub for the button and says "Copmile Error: Wrong Number of Arguents or Invalid property assignment" The line "Call ShowUserRosterMultipleUsers" is highlighted. I have attached the error message...

 

[isetea]

Well, it was my last day and my last try to get it running. Should not be...but thanks a lot for your support.
I make holiday now

 

[WillEllis]

I have been using this code for quite a while, now it doesn't work. I get an error saying that the object or provider is not capable of performing the operation, and highlights:

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

Any suggestions?