INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Jobs

Access Howto:

Activity Monitor - Have you ever needed to view what form(s)/report(s) a user currently has open? by AJParkinson
Posted: 23 Apr 04 (Edited 2 Jun 04)

I had the need just recently to find out which users were in which forms at particular times.
(What lies below might seem long winded, but do read on, most of it is copy & paste!

Briefly our access setup:-

Security (system.mdw) is used.
Link Database (access database containing custom created tables).
SQL Database (existing "off the shelf" enterprise application).
Main User Database (forms, queries etc that read data from above two databases).
Switchboard menus used.
DAO used.
References used thoughout our DB - Visual Basic for Applications, Microsoft Acces 9.0 Object Library, OLE Automation, Microsoft ActiveX Data Objects 2.1 Library, Microsoft DAO 3.6 Objects Library, Microsoft Scripting Runtime.


Disclaimer:
This following works fine for my setup, but I cannot accept any responsibility for your applications. You take this tip as it is - a tip.


Whats needed:
A table in a new/seperate access database to the one you wish to monitor.
A query, a module in the access database you wish to monitor.
A Switchboard menu or main/starting form that remains open in the background in the database you wish to monitor.

Any table/field/variable names etc, can be changed to suit your db but obviously make sure all changes are reflected throughout.


How:
(Note - Step 1 is the only step needed to be carried out outside of the access database you wish to monitor)
1) Create a new table and define 5 columns as follows:
id - autonumber (primary key)
usrnme - text
numopen - number
opened - memo
date - date/time

save the table named as 'activity'

2) In the database you wish to monitor, bring in a link to the 'activity' table you have just created.

3) Create a simple query using only the 'activity' table, and use all columns except 'id', save the query as 'activity_q'.

4) Create a simple form using the 'activity_q' query as its source.  Add all the fields from the query to the form (formatting as you wish, but remember that the 'opened' field will contain at times quite a large amount of text) - also set this fields 'Can Grow' property to 'Yes'.  Set the forms 'Default View' to 'Continuous Form'.  Add a button to exit the form naming it as 'cmdExit'.  Save the form as 'UserActivity'.

5) Press Alt+F11 (or whatever you prefer) to get into the VBA code window for the 'User Activity' form and delete any existing code then copy and paste the code from below.  After copying the code, go back to the form design and set the relevent form load, timer and cmdExit events in the form properties if they have not automatically set themselves.  Save the form as 'UserActivity'.

Option Compare Database

Private Sub Form_Load()
    adbActive
    Me.TimerInterval = 15000
    Me.usrnme.SetFocus
End Sub

Private Sub Form_Timer()
    adbActive
    DoCmd.ShowAllRecords
    Me.usrnme.SetFocus
End Sub

Private Sub cmdExit_Click()
On Error GoTo Err_cmdExit_Click
    DoCmd.Close
Exit_cmdExit_Click:
    Exit Sub
Err_cmdExit_Click:
    MsgBox Err.description
    Resume Exit_cmdExit_Click
End Sub


6) Go back into the VBA environment and add a new module and copy and paste the code below.  After copying the code, save the module as 'useract' or something similar.

Option Compare Database
Option Explicit

Global adbfrm As Object
Global adbfrmnm As String
Global adbfrmnm_l As String
Global adbfrmno As Integer
Global adbrep As Object
Global adbrepnm As String
Global adbrepnm_l As String
Global adbrepno As Integer
Global adbdate As Date
Global adbuser As String
Global abduserchk As String

Global adballnm As String
Global adballno As Integer

Public Sub adbActive()
Dim TmpActDb As DAO.Database
Dim TmpAct As DAO.Recordset
Dim A As Integer
Dim B As Integer
Dim C As Integer
    
    Set TmpActDb = CurrentDb
    Set TmpAct = TmpActDb.OpenRecordset("activity_q")
    Set adbfrm = Nothing
    adbfrmnm_l = 0
    adbrepnm_l = 0
    A = 0
    B = 0
    C = 0
    adballnm = ""
    adballno = 0
    adbfrmnm = ""
    adbfrmno = 0
    adbrepnm = ""
    adbrepno = 0
    adbdate = Now()
    adbuser = CurrentUser
    For Each adbfrm In Forms
        adbfrmnm = adbfrmnm & adbfrm.name & "; >> "
    Next adbfrm
    For Each adbrep In Reports
        adbrepnm = adbrepnm & adbrep.name & "; >> "
    Next adbrep
    
    adbfrmno = Forms.Count
    adbrepno = Reports.Count
    
    adbfrmnm_l = Len(adbfrmnm)
    If Len(adbfrmnm) > 0 Then adbfrmnm_l = adbfrmnm_l - 5
    adbfrmnm = Left(adbfrmnm, adbfrmnm_l)
    If Len(adbfrmnm) > 0 Then adbfrmnm = "FORMS >> " & adbfrmnm
    
    adbrepnm_l = Len(adbrepnm)
    If Len(adbrepnm) > 0 Then adbrepnm_l = adbrepnm_l - 5
    adbrepnm = Left(adbrepnm, adbrepnm_l)
    If Len(adbrepnm) > 0 Then adbrepnm = "REPORTS >> " & adbrepnm
    
    If Len(adbfrmnm) > 0 Then A = 1
    If Len(adbrepnm) > 0 Then B = 2
    C = A + B
    Select Case C
        Case 0
            adballnm = "Nothing open, but MSAccess has not closed down"
        Case 1
            adballnm = adbfrmnm
        Case 2
            adballnm = adbrepnm
        Case 3
            adballnm = adbfrmnm & "; << " & adbrepnm
        Case Else
            MsgBox "Opened forms/reports count is incorrect"
    End Select
    adballno = adbfrmno + adbrepno
    
    
    If TmpAct.RecordCount < 1 Then
        TmpAct.AddNew
        Let TmpAct("usrnme") = adbuser
        Let TmpAct("opened") = adballnm
        Let TmpAct("numopen") = adballno
        Let TmpAct("date") = adbdate
        TmpAct.UPDATE
        Else
        TmpAct.MoveFirst
        Do Until TmpAct.EOF = True
            abduserchk = TmpAct("usrnme")
            If abduserchk <> adbuser Then
                If TmpAct.EOF = True Then
                    TmpAct.AddNew
                    Let TmpAct("usrnme") = adbuser
                    Let TmpAct("opened") = adballnm
                    Let TmpAct("numopen") = adballno
                    Let TmpAct("date") = adbdate
                    TmpAct.UPDATE
                End If
                'Else
                If abduserchk = adbuser Then
                    TmpAct.Edit
                    Let TmpAct("opened") = adballnm
                    Let TmpAct("numopen") = adballno
                    Let TmpAct("date") = adbdate
                    TmpAct.UPDATE
                End If
            End If
            If abduserchk = adbuser Then
                TmpAct.Edit
                Let TmpAct("opened") = adballnm
                Let TmpAct("numopen") = adballno
                Let TmpAct("date") = adbdate
                TmpAct.UPDATE
            End If
            TmpAct.MoveNext
        Loop
    End If
    TmpAct.Close
    Set TmpActDb = Nothing
End Sub

Public Sub adbActiveClose()
Dim TmpActDb As DAO.Database
Dim TmpAct As DAO.Recordset
    
    Set TmpActDb = CurrentDb
    Set TmpAct = TmpActDb.OpenRecordset("activity_q")
    Set adbfrm = Nothing
    adballnm = "Logged Out"
    adballno = 0
    adbdate = Now()
    adbuser = CurrentUser
    
    If TmpAct.RecordCount < 1 Then
        TmpAct.AddNew
        Let TmpAct("usrnme") = adbuser
        Let TmpAct("opened") = adballnm
        Let TmpAct("numopen") = adballno
        Let TmpAct("date") = adbdate
        TmpAct.UPDATE
        Else
        TmpAct.MoveFirst
        Do Until TmpAct.EOF = True
            abduserchk = TmpAct("usrnme")
            If abduserchk <> adbuser Then
                If TmpAct.EOF = True Then
                    TmpAct.AddNew
                    Let TmpAct("usrnme") = adbuser
                    Let TmpAct("opened") = adballnm
                    Let TmpAct("numopen") = adballno
                    Let TmpAct("date") = adbdate
                    TmpAct.UPDATE
                End If
                'Else
                If abduserchk = adbuser Then
                    TmpAct.Edit
                    Let TmpAct("opened") = adballnm
                    Let TmpAct("numopen") = adballno
                    Let TmpAct("date") = adbdate
                    TmpAct.UPDATE
                End If
            End If
            If abduserchk = adbuser Then
                TmpAct.Edit
                Let TmpAct("opened") = adballnm
                Let TmpAct("numopen") = adballno
                Let TmpAct("date") = adbdate
                TmpAct.UPDATE
            End If
            TmpAct.MoveNext
        Loop
    End If
    TmpAct.Close
    Set TmpActDb = Nothing
End Sub


7) This step will depend on how you navigate you database - On the Main Switchboard (or your opening form, this needs to remain open at all times) add the following code into its VBA code window. ****Please note you may already have code in these events, if so add the code below at relevant points in your respective events****.  Go back into the Main Switchboard (your opening form) design mode, and set the events in the form properties, and set the 'Timer Interval' property to '10000'.  Save the form.

Private Sub Form_Close()
    adbrepno = Reports.Count
    adbfrmno = Forms.Count
    Do Until adbrepno = 0
        If adbrepno > 0 Then
            adbrepno = adbrepno - 1
            For X = 0 To Reports.Count - 1
                adbrepnm = Reports(X).name
                DoCmd.Close acReport, adbrepnm
            Next
            Else
            Exit Do
        End If
    Loop
    X = 0
    Do Until adbfrmno = 0
        If adbfrmno > 0 Then
            adbfrmno = adbfrmno - 1
            For X = 1 To Forms.Count - 1
                adbfrmnm = Forms(X).name
                DoCmd.Close acForm, adbfrmnm
            Next
            Else
            Exit Do
        End If
    Loop
    adbActiveClose
End Sub

Private Sub Form_Timer()
    adbActive
End Sub

Private Sub Form_Unload(Cancel As Integer)
    adbActiveClose
End Sub


8) Set permissions for the Table & Query to be fully editible by everyone (eg add new, edit, delete, view etc).  Set the permissions on the Activity form to be viewable by yourself (or those required) only.

Now all that is needed is to allow your users back into the db, open the activity form and you should see in relative real time, which forms are being used by who.

If you wish to comment credit into your db, feel free to do so, my name is Andrew Parkinson
If you wish to add/remove to this code, feel free to do so.
If you wish to rewrite this code to make it more efficient, feel free to do so.
If this code does not work or breaks your app, I apologise, as it is it works for me - but as for blaming me - Don't!





Back to Microsoft: Access Other topics FAQ Index
Back to Microsoft: Access Other topics Forum

My Archive

Resources

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close