Help with found code

[Stephen]

I found the code below in one of my seaches and need some help please. The
code does what I want for, the most part. But what I want, and just can't
figure out, is;

#1. to have the 'comupter name' the code provides, input to a Table instead
of the Immediate Window and without having to type anything special to run
the code.
#2. so, I want to be able to click on my created button for the code to
activate, inputing the results into my table..
#3. I want to be able to use the code from a separate database or at least
activate it from a separate DB.

Your help is greatly appreciated! The code is listed below...

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

Save the module as ShowUsers.
Press CTRL+G to open the Immediate Window.
Type the following line in the Immediate window, and then press ENTER:
ShowUserRosterMultipleUsers
Note that the Immediate window returns a list of users who are logged onto
the database.

 

[Douglas J. Steele]

1. To write the information to a table, change the line of code

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

to an Update query that populates your table.

2. Call ShowUserRosterMultipleUsers from the Click event of your button.
(You could also change ShowUserRosterMultipleUsers to a function, even if it
doesn't return anything, and call the function from the OnClick property of
the button, as opposed to having to create an Event Procedure that calls the
sub)

3. To get the information for a different database, change the line of code

Set cn = CurrentProject.Connection

to point to a different database, like

cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data
Source=C:\mydatabase.mdb;User Id=admin;Password=;"

 

[Douglas J. Steele]

The answer to question 3 fell victim of word wrap. That should be a single
line, not two as it's appearing.

Rewritten to use a line-continuation character, it would be

cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=C:\mydatabase.mdb;User Id=admin;Password=;"

 

[Stephen sjw_ost]

Ok, so #2 and #3 I got and they work great!, Thank you!
However, #1 is getting the best of me. I just can't seem to get my brain
wrapped around how to convert the Debug.Print portion to an update query. I
am trying to figure it out on my own, but can you give a bit more of a hint
on how to do that? I tried creating a query in the database but I'm not sure
how to tie it to the rs.Fields (0) to pick up the computer name.

Thank you again!

 

[Stephen sjw_ost]

Right, I got #2 and #3, it's the converting the Debug.Print to an update
query that I'm having trouble understanding. I've tried the following of
which I found in the HELP sections of Access, modified of course.

Function ShowUserRosterMultipleUsers()
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim i, j As Long
Dim SQL As String 'My attempted addition

'Set cn = CurrentProject.Connection
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data
Source=G:\OST\SWITCHBOARD\MESSENGER\JAX_Messenger_FE_OST.mdb;User
Id=admin;Password=;"

' 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
SQL = "UPDATE T_CurrentUsers" & _ 'My attempted addition
"SET T_CurrentUsers.ComputerName = rs.Fields(0)" & _ 'My
attempted addition
"WHERE T_CurrentUsers.ComputerName = """ 'My attempted addition
rs.MoveNext
Wend

'CRTL+G then enter "ShowUserRosterMultipleUsers" into the Immediate
Window and press ENTER.
End Function

Of course it's not working. Thank you for your reply(s).

 

[Douglas J. Steele]

I don't believe an Update query is appropriate.

Let's assume that the first time you run the code, Tom and Mary are the
users in the database. The next time you run it, Tom has logged off, but
Brent and Kay are using it in addition to Mary. While you can use an Update
query to replace Tom's entry with Brent's, an Update query won't let you add
Kay. (For that matter, how did Tom and Mary get into your User table in the
first place?)

What you may want to do each time you run the routine is delete the existing
data from the table and insert the new data. The problem with that, though,
is that your database size is going to keep growing due to the deletions and
insertions.

The recordset you're creating returns four fields: COMPUTER_NAME (a text
field), LOGIN_NAME (a text field), CONNECTED (I'm not really sure, but I'm
assuming it's a text field) and SUSPECT_STATE (a boolean field). Assuming
you've created a table named T_CurrentUsers with those four fields, try:

Sub ShowUserRosterMultipleUsers()
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim cm AS ADODB.Command
Dim strSQL As String

Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
"F:\Folder\File.mdb;User Id=admin;Password=;"

' Empty the existing table
strSQL = "DELETE FROM T_CurrentUsers"
Set cm = New ADODB.Command
Set cm.ActiveConnection = cn
cm.CommandType = adCmdText
cm.CommandText = strSQL
cm.Execute

' Open the recordset of the current users.
Set rs = cn.OpenSchema(adSchemaProviderSpecific, , _
"{947bb102-5d43-11d1-bdbf-00c04fb92675}")

While Not rs.EOF
strSQL = "INSERT INTO T_CurrentUsers " & _
"(COMPUTER_NAME, LOGIN_NAME, CONNECTED, SUSPECT_STATE) " & _
"VALUES ('" & rs.Fields(0) & "', '" & rs.Fields(1) & "', '" &_
rs.Fields(2) & "', " & rs.Fields(3) & ")"
cm.CommandText = strSQL
cmExecute
rs.MoveNext
Wend

rs.Close
End Sub

Pay close attention to the puncutation in that INSERT statement. Since some
of the fields are text, you need to have quotes around them, so that,
exagerated for clarity, that's

"VALUES ( ' " & rs.Fields(0) & " ', ' " & rs.Fields(1) & " ', ' " &_
rs.Fields(2) & " ', " & rs.Fields(3) & ")"

 

[Stephen sjw_ost]

My thoughts exactly.
I have made the table T_CurrentUsers and all fields are set to text.
When I try to step thru the code I get:
"Compile Error- Sub or Function not defined "
and it highlights the last cm.Execute in the code.
When I comma out the last instance of cm.Execute, it tells me it can't find
the table T_CurrentUsers. When I comma out the 1st instance of cm.Execute I
get the Compile Error above.
I comma'd out the 2 cm.Execute lines and was able to step thru the rest of
the code.
Any suggestions on how to correct? I copied your code and checked to be sure
the text fileds have quotes. Maybe I missed something? Thanks for your help.

 

[Douglas J. Steele]

Let's see what your code looks like. (My code inadvertently has cmExecute
instead of cm.Execute, so you might have made a similar error)

 

[Stephen sjw_ost]

The last cm.Execute was like cmExecute. I fixed that but am still getting the
error that the table T_CurrrentUsers can't be found. Below is the code
exactly as I have it now.

Sub ShowUserRosterMultipleUsers()
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim cm As ADODB.Command
Dim strSQL As String

Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
"H:\Shortcuts&Links\M Y P R O J E C T S\MISC\AGENTID.mdb;User
Id=admin;Password=;"

' Empty the existing table
strSQL = "DELETE FROM T_CurrentUsers"
Set cm = New ADODB.Command
Set cm.ActiveConnection = cn
cm.CommandType = adCmdText
cm.CommandText = strSQL
cm.Execute

' Open the recordset of the current users.
Set rs = cn.OpenSchema(adSchemaProviderSpecific, , _
"{947bb102-5d43-11d1-bdbf-00c04fb92675}")

While Not rs.EOF

strSQL = "INSERT INTO T_CurrentUsers" & _
"(COMPUTER_NAME, LOGIN_NAME, CONNECTED, SUSPECT_STATE)" & _
"VALUES ('" & rs.Fields(0) & "', '" & rs.Fields(1) & "', '" & _
rs.Fields(2) & " ', " & rs.Fields(3) & ")"

cm.CommandText = strSQL
cm.Execute
rs.MoveNext
Wend

rs.Close
End Sub

 

[Douglas J. Steele]

Does T_CurrentUsers exist in your AgentID.mdb, or is it in a different
database?

If it's a different database, you'll need to create a separate Connection
object that connects to whichever database contains the table and use that
connection object with the Command object cm.

 

[Stephen sjw_ost]

It is now. But when I step thru the code I now get;

Run-Time error '-2147217900(80040a14)':
Syntax error in string in query expression "PC NAME'.

When I choose Debug, cm.Execute is once again highlighted.
However, I would like the T_CurrentUsers to be in the DB that has the code.
The DB that has the code is named IDAUser.mdb. That way it is one package,
all in one DB, pulling the required info into IDAUser.mdb.

 

[Douglas J. Steele]

I don't see PC NAME anywhere in your code!

Inside the loop, try:

While Not rs.EOF

strSQL = "INSERT INTO T_CurrentUsers" & _
"(COMPUTER_NAME, LOGIN_NAME, CONNECTED, SUSPECT_STATE) " & _
"VALUES ('" & rs.Fields(0) & "', '" & rs.Fields(1) & "', '" & _
rs.Fields(2) & " ', " & rs.Fields(3) & ")"

Debug.Print strSQL

cm.CommandText = strSQL
cm.Execute
rs.MoveNext
Wend

Now, when the code fails, go to the Immediate Window (Ctrl-G) and see the
SQL string printed there.

Note that I've got a space after the closing parenthesis on the second line
of the SQL statement.

 

[Stephen sjw_ost]

Immediate Window shows;

INSERT INTO T_CurrentUsers(COMPUTER_NAME, LOGIN_NAME, CONNECTED,
SUSPECT_STATE) VALUES ('WSUSJXC2B2A169A ', 'admin
', 'True ', )

When it fails. the WSUSJXC2B2A169A is PC NAME.
I have a table T_CurrentUsers in both the IDAUSER.mdb and AGETNID.mdb.

 

[Douglas J. Steele]

While WSUSJXC2B2A169A is a PC NAME, I cannot see how your error message
would mention PC NAME in it since your code doesn't call anything PC NAME!

 

[Stephen sjw_ost]

WSUSJXC2B2A169A is the PC NAME. I mearly called it PC NAME when descrbing the
error. PC NAME is not part of the code, it is only a description of
WSUSJXC2B2A169A that I used to present the error that was occuring. Sorry for
the confusion.

 

[Douglas J. Steele]

Okay, I see.

I only see three value fields in your SQL statement:

INSERT INTO T_CurrentUsers(COMPUTER_NAME, LOGIN_NAME, CONNECTED,
SUSPECT_STATE) VALUES ('WSUSJXC2B2A169A ', 'admin
', 'True ', )

The only thing I can think of is that there are special characters in the
apparent spaces between the PC Name and the closing quote.

Let's step back a minute, though. Why do you want to store this information
in a table?

 

[Stephen sjw_ost]

I have 23 PCs that have access to the DBs I want to ID the operating user. I
only want to ID the PC NAME that is currently using the DBs that we have
access to at my company.
What I am going to do is make a separate, static table that will list all 23
of the PC NAMEs with the owners name in a second column. When the code pulls
in the PC NAME that is currently using the DB to the table T_CurrentUsers, I
will tie the 2 tables together and have the IDAUSER.mdb produce a report
listing the owners name(s) that is currently using the DB. This way, I can
track who is currently using the DB, remotely. I will also be able to tell if
someone who is not suppose to be in the DB has it open and find out from them
why they have it up. Once the report is produced the ID'd PC NAME info will
be deleted from the T_CurrentUsers table, to keep the IDAUSER.mdb size down.
Hope this helps with understanding my intent with this code.
Thanks.

 

[Douglas J. Steele]

Sounds to me like there's no need to save the entire details from the
recordset.

For that matter, you don't really even need to worry about the code you've
got. http://www.mvps.org/access/api/api0008.htm and
http://www.mvps.org/access/api/api0009.htm at "The Access Web" will give you
the User ID and Computer Name respectively.

As the application starts, check whether the computer already in the table.
If it isn't, add the PC and User IDs. If it is, make sure that the user id
associated with it is the same as the current user. It's possible you'll
have to deal with a many-to-many relationship between Computer and User

 

[Stephen sjw_ost]

The only detail I need from the recordset is the computer name. I want it to
be input into a table within the same DB as the code that is looking for the
recordset. The code you directed me to, I already have and am using to record
who loged in and out of the DB and at what time they did so. But I don't see
how either will tell me who is logged into the DB, right now, from what
workstation, multiple users, remotely, from a separate DB. I would like to
figure out how to finish converting the code in question in this discussion.
I'll keep investigating.
Thank you for the suggestions and assistance.

 

[Douglas J. Steele]

Yes, you need a table that indicates which user is associated with which
machine, and you can get that simply by checking the computer name and user
id as each user enters the application.

Once you have that information, if you're wanting to determine, at any point
in time, who all is logged into the application based on the code from that
KB article, I don't see the reason for populating the results into a table.

In any case, what you've posted as the content of the SQL string appears to
only have 3 pieces of data in VALUES list, whereas there are four fields
listed.