Improve ShowUser utility?

[gojets1721]

Right now, I use this guide to show me who is currently logged into the DB. It works fine for me, but admittedly, its more difficult for the less experienced access users on the team to utilize. I was curious if anyone had any suggestions on how to maybe convert this to a query? So that all the users just populate there, instead of having to open the module and insert into the immediate window

The guide's code is below too:

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

    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

 

[theDBguy]

I guess you would have to change the Debug.Print lines to insert the values into a table. Would you know how to do that?

 

[theDBguy]

Another thought is to store the values in a variable and then maybe just use a Message Box to show them?

 

[CJ_London]

Agree with dbg - either insert to a table or populate a valuelist rowsource in a listbox or combo

 

[Pat Hartman]

Unless you need to work with the list, I would use a message box or perhaps a form with a list box that is loaded with VBA. Saving the data in a temp table only leads to bloat so you would need to have a real reason to incur that bloat when other display options won't cause a problem.

 

[Pat Hartman]

Or, just copy the form and other necessary parts from the ShowRoster database where you got the code from.

 

[gojets1721]

A message box would be perfect. I don't need to work the list. How would you suggest to code that though?

 

[Pat Hartman]

Define a variable
Replace the Debug.Print with

strUsers = strUsers & rs.Fields(0) & " " & rs.Fields(1) & " " & rs.Fields(2) & " " & rs.Fields(3) & vbCrLf

Then, after the wend, display the messagebox

Msgbox strUsers, vbOkOnly

 

[isladogs]

I used the ShowUserRosterMultipleUsers many years ago with MDB files but long since stopped doing so
As you may have noticed it will return ADMIN as the login name in all recent versions of Access ...which isn't helpful to you
You get the workstation but not the actual username

Typical output:
COLIN-PC Admin True Null

However there are simpler & better alternatives
If your users login to your database, you can just save the login info (username/workstation/login time etc).

Otherwise use one of the standard methods of getting user names from the Windows login:

Get User Name

This article describes 3 common methods of getting the current user name in Access

www.isladogs.co.uk

I recommend using CreateObject("WScript.Network").UserName for this purpose

and for the workstation, use e.g. CreateObject("WScript.Network").ComputerName

 

[Pat Hartman]

One of the versions I have shows the user name. I don't have a way to test it on a network at the moment. I also don't remember where I downloaded it from but it is fairly old. I'll attach a picture and the database which works on both .mdb and .accdb. If one of you can test it and let us know if it actually gets different users, that would be great.

 

[isladogs]

I remember that utility & used it myself in the past.
It uses the JET Roster code but then gets the user name by a different method;

      If strComputerName = LocalUser.ComputerName Then
                strLoginName = LocalUser.Domain & "\" & LocalUser.Name
            Else
                Dim ru As New RemoteUser
                ru.Load strComputerName
                strLoginName = ru.Name
                
                'strLoginName = fGetUserID(strComputerName)
            End If

This is what it just gave for me:

BUT using the code I gave earlier, I get each of those results in one line:

?CreateObject("WScript.Network").UserName
cridd

?CreateObject("WScript.Network").ComputerName
COLIN-PC

My earlier points still stand....

 

[gojets1721]

Define a variable
Replace the Debug.Print with

strUsers = strUsers & rs.Fields(0) & " " & rs.Fields(1) & " " & rs.Fields(2) & " " & rs.Fields(3) & vbCrLf

Then, after the wend, display the messagebox

Msgbox strUsers, vbOkOnly

This worked! However, is their a way to link the message box to a command button?

I ask because the above still requires me to enter the module and then run it. If users could press a button and that message box appears, that would be perfect.

 

[gojets1721]

Nvm! I called the sub and that did it. Thanks all!!

 

[Pat Hartman]

Add a command button. Stop the wizard. Change the control name to something rational like "cmdShowRoster". Then in the click event of the button call the procedure.

Call ShowUserRosterMultipleUsers()

I would also go back and tag the procedure as Public. I think the default is private. You actually want the procedure to be in a standard module so you can call it from any form.

 

[gojets1721]

Add a command button. Stop the wizard. Change the control name to something rational like "cmdShowRoster". Then in the click event of the button call the procedure.

Call ShowUserRosterMultipleUsers()

I would also go back and tag the procedure as Public. I think the default is private. You actually want the procedure to be in a standard module so you can call it from any form.

So I'm running into an issue with what is being shown. The message box shows up from the command, but it only lists one user. Even if multiple are in there (I tested to ensure). Any idea why? Here's my exact module code

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

    Set cn = CurrentProject.Connection

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

    strUsers = strUsers & rs.Fields(0) & " " & rs.Fields(1) & " " & rs.Fields(2) & " " & rs.Fields(3) & vbCrLf

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

End Sub

 

[Pat Hartman]

Is it because of the line feed? Can you expand the box? Put a stop on the msgbox and then print the contents in the debug window.

? strUsers


PS, you also didn't define the variable. Add

Dim strUsers as String

To the top of the procedure.

 

[MarkK]

Also, an ADODB.Recordset exposes a GetString method, which you can use like...

Sub MsgBoxUsers()
    Const SCHEMA_GUID = "{947bb102-5d43-11d1-bdbf-00c04fb92675}"
    With CurrentProject.Connection.OpenSchema(adSchemaProviderSpecific, , SCHEMA_GUID)
        MsgBox .GetString
    End With
End Sub

 

[gojets1721]

Is it because of the line feed? Can you expand the box? Put a stop on the msgbox and then print the contents in the debug window.

? strUsers


PS, you also didn't define the variable. Add

Dim strUsers as String

To the top of the procedure.

Okay I added the string.

I can't expand the message box. I'm also not sure how the print works. I dropped a question mark in front of the msgbox line and got a compile error saying method not valid..

 

[Pat Hartman]

you have to have the form open and the code needs to have a break on the line that displays the message box. Then you can use

Print strUsers

or

? strUsers

 

[gojets1721]

you have to have the form open and the code needs to have a break on the line that displays the message box. Then you can use

Print strUsers

or

? strUsers

Hoping you can help with the example I've attached. I'm trying to get the module to work in a form, but I'm getting a #Name error. And I'm too inexperienced to enact what you said above. Can you take a look at the example and show your suggestions?