Capture debug.print of users logged into database

[MitchR]

I am looking to capture the Debug.print of computers connected to the backend of my database. Using the Microsoft example I can see the list of computers connected to my backend. I would like to capture the information displayed in the debug.print and send to my self in an email.

    '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
 

[ADezii]

You can build a String consisting of all the needed info, as in:

'Output the list of all Users in the current database.
strBuild = rs.Fields(0).name & "," & rs.Fields(1).name & "," & rs.Fields(2).name & _
           "," & rs.Fields(3).name & vbCrLf
 
'Add Data for each User to the String (strBuild)
Do While Not rs.EOF
  strBuild = strBuild & rs.Fields(0) & "," & rs.Fields(1) & "," & _
             rs.Fields(2) & "," & rs.Fields(3) & vbCrLf
               rs.MoveNext
Loop
 
'Strip ending Carriage Return/Line Feed, all needed info is now
'contained in strBuild. Place in the Body of an E-Mail Message
strBuild = Left$(strBuild, Len(strBuild) - 2)

Sample OUTPUT:

ShipperID,CompanyName,Phone,NoName
1,Speedy Express,[phone],1
2,United Package,[phone],3
3,Federal Shipping,[phone],5

[Rabbit]

You can send e-mail to yourself using CDO.

[NeoPa]

Tell me if I'm off-track here, but wouldn't passing that information be more straightforward if, instead of using Debug.Print, you added the data as records to a table in your BE database. You would have the same flexibility of format and full control of whether to keep all records as a log or to process them in batches. I'd include a Date/Time value too if I were you, but you probably understand your specific requirements more precisely than I.

[ADezii]

@NeoPa - I definitely see your point, and that was my initial approach. The way I see it, you would have to write timed code to dynamically Add and Delete Users who would be Logged On to the Back End at any given moment. Depending on what the OP is trying to achieve, it may not be worth the effort - I was thinking more or less along the lines of a Snapshot of who is Logged On at any given time. Could also be that I misread the request! (LOL).

[NeoPa]

I wasn't considering the scheduling or triggering of any such code ADezii. It seemed to me that any time the code could run a Debug.Print, it could also run code to add a, or some, records into such a log table.

I'm sure we could also help with that if required, but I didn't read that as part of the request.

[MitchR]

My goal is to have the listing of computers connected to my back end @ 2:00am local time emailed to me. I have the lotus notes code working, and I am able to see all of the computers logged in from debug.print. Unfortunately; when I receive the email using Adezii's solution I only see one computername listed. I can see all of the headings. Let me post my entire solution.

Public Function ShowUserRosterMultipleUsers()
    Dim cn2 As New ADODB.Connection
    Dim cn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim i, j As Long
    Dim varUsers As Variant
    Dim VarComputername As String
    Dim MsgBody As String
    Dim varState As Variant
    Dim DBConnect As String
 
    DBConnect = "\\server\DB_be.mdb"
    'Set cn = CurrentProject.Connection
 
 
    cn.Provider = "Microsoft.Jet.OLEDB.4.0"
    cn.Open "Data Source=" & DBConnect
 
    cn2.Provider = "Microsoft.Jet.OLEDB.4.0"
    cn2.Open "Data Source=" & DBConnect
 
 
 
    ' 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.
 strbuild = rs.Fields(0).Name & "   " & rs.Fields(1).Name & "   " & rs.Fields(2).Name & _
           "   " & rs.Fields(3).Name & vbCrLf & vbCrLf
 
 
 
'Add Data for each User to the String (strBuild)
Do While Not rs.EOF
  strbuild = strbuild & rs.Fields(0) & rs.Fields(1) & _
             rs.Fields(2) & rs.Fields(3) & vbCrLf
               rs.MoveNext
Loop
 
 
'Strip ending Carriage Return/Line Feed, all needed info is now
'contained in strBuild. Place in the Body of an E-Mail Message
strbuild = Left$(strbuild, Len(strbuild) - 2)
Debug.Print strbuild 'For Testing purposes
Dim Subject As String
 
Dim recip(25) As Variant
'recip(1) = "Email Address1"
recip(0) = "MyEmailAddress"
Subject = "Notification computers Logged into Database at time of Nightly updates"
MsgBody = strbuild
 
 
Dim s As Object          
Dim db As Object         
Dim doc As Object        
Dim sMsg As String
Dim varFrom As Variant   
Dim UserName As String   
 
    Set s = CreateObject("Notes.Notessession")       
    UserName = s.UserName                               'Notes Sender
    Set db = s.getDatabase("", "")                      'Set db to database not yet named
    Call db.Openmail                                    'Set database to default mail database
    Set doc = db.CreateDocument                         'Notesdocument '.New  '(db)   ' create a mail document
    doc.Form = "Memo"                                   'Style of Lotus Form
    doc.SAVEMESSAGEONSEND = True                        'Save a copy in the Sent items?
 
    Call doc.REPLACEITEMVALUE("From", UserName)         'Place the Senders info in message
    doc.SendTo = recip                                  'Address the Email
    Call doc.REPLACEITEMVALUE("Subject", Subject)       'Set The Subject
    Call doc.REPLACEITEMVALUE("Body", MsgBody)          'Set the Body of the message
 
    doc.Send 0                                          'Send the message
    doc.Visible = True
 
    Set s = Nothing                                     'Close connection to free memory
    Set db = Nothing                                    'Cleanup
    Set doc = Nothing                                   'Cleanup
 
 
End Function
 

[ADezii]

Unless I am missing something very obvious, I see no reason why it should not work, try:

1. Explicitly Declaring the Build Variable (Code Line #2):
   

   Dim strBuild As String

2. Do an explicit MoveFirst within the Recordset, prior to iterating it (Code Line #12):
   

   rs.MoveFirst

   'Code intentionally omitted
   Dim strBuild As String
    
   Set rs = cn.OpenSchema(adSchemaProviderSpecific, _
                          , "{947bb102-5d43-11d1-bdbf-00c04fb92675}")
    
    
   'Output the list of all Users in the current database.
    strBuild = rs.Fields(0).name & "   " & rs.Fields(1).name & "   " & rs.Fields(2).name & _
              "   " & rs.Fields(3).name & vbCrLf & vbCrLf
    
   rs.MoveFirst
    
   'Add Data for each User to the String (strBuild)
   Do While Not rs.EOF
     strBuild = strBuild & rs.Fields(0) & rs.Fields(1) & _
                rs.Fields(2) & rs.Fields(3) & vbCrLf
                  rs.MoveNext
   Loop
   'Code intentionally omitted