Microsoft Access Object (Form, Report, Module) Usage Statistics

Last updated 2008/01/21

You can track usage statistics for forms and reports by adding a record to a table in the form or reports OnOpen event.   For modules you can do this as the third line in any function or subroutine.  (The first line is a description of the function/subroutine.  The second line is your On Error Goto line.  (Hmm, you likely can within macros by using a function call with the name of the macro as a parameter.)

For forms this is the line inserted in the OnOpen event.
 Call AddFormReportLogging("Forms", Me.Name)
For reports
 Call AddFormReportLogging("Reports", Me.Name)

The module is as follows.  Now I could've saved storage space by doing a lookup on the form/report name in a  table and save the ID field.  However I felt this would slow down the app a little.  However I didn't actually do any timing tests on this.

Public Sub AddFormReportLogging(strObjectType As String, strObjectName As String)

On Error GoTo tagError

    Dim intObjectType As Integer, strSQL As String, lngUserID As Long

    Select Case strObjectType
    Case "Forms"
        intObjectType = 2
    Case "Reports"
        intObjectType = 3
    Case Else
        intObjectType = 9
    End Select

    strSQL = "INSERT INTO zsysObjectUsage ( zouObjectType, zouObjectName, zouUserID, zouDateTimeUsed ) " & _
        "IN 'Z:\Objectusage.mdb' " & _
        "VALUES (" & intObjectType & ", '" & strObjectName & "', " _
            & fOSUserName & ", " & Format$(Now, JetDateTimeFmt) & ");"
    CurrentDb.Execute strSQL, dbFailOnError

    Exit Sub

    If Err.Number = 2450 Then ' Forms not found 
        lngUserID = 0
        Resume Next
        MsgBox Err.Description
    End If
    Exit Sub

End Sub
Private Declare Function apiGetUserName Lib "advapi32.dll" Alias _
    "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Public Function fOSUserName() As String ' Returns the network login name
    Dim lngLen As Long, lngx As Long
    Dim strUserName As String
On Error GoTo tagError
    strUserName = String$(254, 0)
    lngLen = 255
    lngx = apiGetUserName(strUserName, lngLen)
    If lngx <> 0 Then
        fOSUserName = Left$(strUserName, lngLen - 1)
        fOSUserName = ""
    End If
    Exit Function
    MsgBox Err.Description
    Exit Function
End Function

For info on JetDateTimeFmt see Date/Time: Return Dates in US #mm/dd/yyyy# format

[ Access | Main ]