List Database Users

[MrH via AccessMonster.com]

I have a split DB that I want to be able to see who is using. I located this
code from Microsoft. Works fine when you simply put
"ShowUserRosterMultipleUsers" in the immediate window. BUT... I want to
execute the code from a form. I've tried a form with one unbound listbox, set
the source to "ShowUserRosterMultipleUsers()"
But it returns nothing. I tried putting the code in the form instead of a
module... but doesn't seem to work either.
How can I get the results I'm looking for?

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

cn.Provider = "Microsoft.Jet.OLEDB.4.0"
cn.Open "Data Source=c:\Northwind.mdb"

cn2.Open "Provider=Microsoft.Jet.OLEDB.4.0;" _
& "Data Source=c:\Northwind.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 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

Thanks
Curtis

 

[Douglas J. Steele]

Assuming you want the user id (rs.Fields(1) in your Debug.Print statement),
try:

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

cn.Provider = "Microsoft.Jet.OLEDB.4.0"
cn.Open "Data Source=c:\Northwind.mdb"

cn2.Open "Provider=Microsoft.Jet.OLEDB.4.0;" _
& "Data Source=c:\Northwind.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 rs = cn.OpenSchema(adSchemaProviderSpecific, _
, "{947bb102-5d43-11d1-bdbf-00c04fb92675}")

'Create a list of all users in the current database.

Do While Not rs.EOF
strUsers = strUsers & _
Trim(Left(rs.Fields(1), InStr(rs.Fields(1), Chr(0)) - 1)) & ";"
rs.MoveNext
Loop

' Remove the extraneous semicolon from the end
If Len(strUsers) > 0 Then
strUsers = Left$(strUsers, Len(strUsers) - 1)
End If

ShowUserRosterMultipleUsers = strUsers

End Function


You can then set the RowSource for your combo box using this:

Me.MyListBox.RowSource = ShowUserRosterMultipleUsers()
Me.MyListBox.RowSourceType = "Value List"

 

[MrH via AccessMonster.com]

Thank you !
It works....... BUT.... Now I am finding out that the original code does not
work properly. When I put the path to my mdb file in the data source it only
returns my computer, not any others logged on.... So I guess its time to look
for another method.

 

[Douglas J. Steele]

Sorry, I'm not seeing that behaviour.

What change did you make to the code to ensure it's pointing to the correct
database?

BTW, you do realize that unless you've applied Access User-Level Security
(so that your users need to log into the application with a username and
password), it's going to return Admin for all users.

 

[MrH via AccessMonster.com]

Its pointing to the correct DB......
I did not know I've applied Access User-Level Security. Returning the name of
the computer was all I was looking for. Security is not an issue on this one
and I really didn't want to use any.