RIAS
asked on
Create macro from runcode
Hello,
I have a module as in :
https://support.microsoft.com/en-us/help/285822/how-to-determine-who-is-logged-on-to-a-database-by-using-microsoft-jet-userroster-in-access
I need to create a macro ,so that when the user clicks on the Run macro the results are displayed.
Wnen i tested the code ,i had to open a immediate window to see the results.
is there any way the results are displayed on a form when I run the macro.
I am using access 2013 .
Cheers
I have a module as in :
https://support.microsoft.com/en-us/help/285822/how-to-determine-who-is-logged-on-to-a-database-by-using-microsoft-jet-userroster-in-access
I need to create a macro ,so that when the user clicks on the Run macro the results are displayed.
Wnen i tested the code ,i had to open a immediate window to see the results.
is there any way the results are displayed on a form when I run the macro.
I am using access 2013 .
Cheers
ASKER
Cheers Bill! Wil try and brb
Another approach that wouldn't be too hard if you are using this only occasionally for troubleshooting could be to write the txt variable that I have built with the results to a text file on the computer, and then open it in Notepad for viewing. That would be easy to do, if that could meet your need?
~bp
~bp
ASKER
ok
ASKER
Bill,
its just giving me the ComputerName and not the login_Name or username?
its just giving me the ComputerName and not the login_Name or username?
Is that all you were seeing in the Immediate window (I can't test here), it should be the same results just in a MsgBox instead of the Immediate window.
~bp
~bp
ASKER
Nope,
In immediate window it shows everything,but msgbox just shows the computer name
In immediate window it shows everything,but msgbox just shows the computer name
ASKER
Output from immediate window :
Output from msgbox
COMPUTER_NAME LOGIN_NAME CONNECTED SUSPECT_STATE
PC5
COMPUTER_NAME LOGIN_NAME CONNECTED SUSPECT_STATE
PC5 Admin True Null
Output from msgbox
COMPUTER_NAME LOGIN_NAME CONNECTED SUSPECT_STATE
PC5
Just for a test try this please, it may be some of the those fields have nulls in them and could be affecting the output. Also check the immediate window and see what it shows.
Sub ShowUserRosterMultipleUsers()
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim i, j As Long
Dim txt As String
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.
txt = ""
txt = txt & rs.Fields(0).Name & " " & rs.Fields(1).Name & " " & rs.Fields(2).Name & " " & rs.Fields(3).Name & vbCrLf
While Not rs.EOF
txt = txt & Replace(rs.Fields(0), Chr(0), " ") & " " & Replace(rs.Fields(1), Chr(0), " ") & " " & Replace(rs.Fields(2), Chr(0), " ") & " " & Replace(rs.Fields(3), Chr(0), " ") & vbCrLf
rs.MoveNext
Wend
Debug.Print txt
MsgBox txt
End Sub
~bp
ASKER
Error:
invalid use of null
invalid use of null
txt = txt & Replace(rs.Fields(0), Chr(0), " ") & " " & Replace(rs.Fields(1), Chr(0), " ") & " " & Replace(rs.Fields(2), Chr(0), " ") & " " & Replace(rs.Fields(3), Chr(0), " ") & vbCrLf
Okay, let's try a slightly different approach.
Sub ShowUserRosterMultipleUsers()
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim i, j As Long
Dim txt As String
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.
txt = ""
txt = txt & rs.Fields(0).Name & " " & rs.Fields(1).Name & " " & rs.Fields(2).Name & " " & rs.Fields(3).Name & vbCrLf
While Not rs.EOF
txt = txt & Trim(rs.Fields(0).Value) & " " & Trim(rs.Fields(1).Value) & " " & Trim(rs.Fields(2).Value) & " " & Trim(rs.Fields(3.Value) & vbCrLf
rs.MoveNext
Wend
Debug.Print txt
MsgBox txt
End Sub
Function Clean(s As String)
End Function
~bp
ASKER
trying..
ASKER
Nope,
looks like msgbox is just not displaying two values ;
looks like msgbox is just not displaying two values ;
Okay, for a test try the attached. Adjust the patch for the TXT file it will write as needed in the call to DoWrite. Then after it runs open the output file in Notepad or your favorite text editor and see what it looks like.
Sub ShowUserRosterMultipleUsers()
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim i, j As Long
Dim txt As String
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.
txt = ""
txt = txt & rs.Fields(0).Name & " " & rs.Fields(1).Name & " " & rs.Fields(2).Name & " " & rs.Fields(3).Name & vbCrLf
While Not rs.EOF
txt = txt & Trim(rs.Fields(0).Value) & " " & Trim(rs.Fields(1).Value) & " " & Trim(rs.Fields(2).Value) & " " & Trim(rs.Fields(3.Value) & vbCrLf
rs.MoveNext
Wend
DoWrite "c:\temp\roster.txt", txt
End Sub
Sub DoWrite(p As String, X As String)
f = FreeFile
Open p For Output As #f
Print #f, X
Close #f
End Sub
~bp
I think I did confirm that it is nulls in the field data that is messing with MsgBox, based on this simple test. So perhaps I can find a different way to remove those, trying now...
Sub Test()
s = "aaa" & Chr(0) & "bbb" & Chr(0) & "ccc"
MsgBox s
s = "aaa" & Chr(32) & "bbb" & Chr(32) & "ccc"
MsgBox s
End Sub
~bp
ASKER
Bill,
That worked but,a messagebox will be better option.
Can you help?
That worked but,a messagebox will be better option.
Can you help?
Yes, let me find a way to get those Null characters out of the fields.
~bp
~bp
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
trying..
ASKER
Error:
Invalid use of null
Invalid use of null
txt = txt & TrimNull(rs.Fields(0).Value) & " " & TrimNull(rs.Fields(1).Value) & " " & TrimNull(rs.Fields(2).Value) & " " & TrimNull(rs.Fields(3).Value) & vbCrLf
Argh. Interesting since I did this test here and it seemed to work. Let me research a bit further... It appears the nulls in the fields behave a bit differently than nulls in a built string...
Sub Test()
s = "xxxxxxxxx" & TrimNull("aaa" & Chr(0)) & TrimNull("bbb" & Chr(0)) & TrimNull("ccc" & Chr(0))
MsgBox s
End Sub
Function TrimNull(s As String) As String
Dim i As Integer
i = InStr(s, Chr(0))
If i > 0 Then
TrimNull = Left(s, i - 1)
Else
TrimNull = s
End If
End Function
~bp
If you F8 though the one you got the error on, does it ever go into the TrimNull function, or just error on the line that builds the txt variable?
~bp
~bp
ASKER
just error on the line that builds the txt variable?
ASKER
Does not build ,it errors on that line
ASKER
Cheers mate!
ASKER
Don't thonk I need all parameters so used :
Sub ShowUserRosterMultipleUsers()
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim txt As Variant
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.
'Output the list of all users in the current database.
txt = ""
txt = txt & rs.Fields(0).Name & " ; " & rs.Fields(1).Name & " " & vbCrLf
While Not rs.EOF
txt = txt & TrimNull(rs.Fields(0)) & " ; " & TrimNull(rs.Fields(1)) & "" & vbCrLf
rs.MoveNext
Wend
MsgBox txt
End Sub
ASKER
Thanks a lot!!!!
Welcome, sorry that was harder than it should have been...
~bp
~bp
ASKER
No worries mate! Thanks !
Open in new window
~bp