505.369.1650 [email protected]

This set of functions will let you track how long it took for one or more pieces of VBA code to run.  The logic includes three sections:  name and initialize the , end the timer, and write the results to a log file.

Here is an example of timing part of the CalcHoursOrMinutes() procedure:

StartTimer "CalcHoursOrMinutes"
    ' Get the total minutes.
    lngTotalMinutes = (Nz(Hours, 0) * 60) + Nz(Minutes, 0)

    ' Get the hours.
    lngHours = Int(lngTotalMinutes / 60)

    ' Get the minutes.
    lngMinutes = lngTotalMinutes - (lngHours * 60)

    If CalcType = "Hours" Then
        CalcHoursOrMinutes = lngHours
        CalcHoursOrMinutes = lngMinutes
    End If

The of code to be timed starts with a call to StartTimer() and ends with a call to EndTimer(). The EndTimer() procedure writes the timer results to a log file, which gets saved in the same folder as the project. For the example above, the tab-delimited results would look like this:

Timestamp	TimerName	ElapsedTime
10/30/2013 6:28:35 AM	CalcHoursOrMinutes	0.046875

When the text file is imported into Microsoft Excel or Microsoft Access, the file will create three , using the first row as the header.

The timer log procedures can be called multiple times in a work process, but they cannot be nested.


Option Compare Text
Option Explicit

' basTimerLog() Version 1.0.0
' Copyright © 2013 Extra Mile Data, www.extramiledata.com.
' For questions or issues, please contact [email protected]
' Use (at your own risk) and modify freely as long as proper credit is given.

' This code module provides some procedures that can be used to start
' and end a timer, and then place the timer results in a tab-delimited
' text file.  Example:
' StartTimer "Loop through recordset"
'     Code here...
' EndTimer

' Determines whether or not we are using timers.
Public Const mblncTimer As Boolean = True

Public mvarTimerName
Public mvarTimerStart

Public Function StartTimer(TimerName)
' This procedure initializes the timer.
On Error GoTo Err_Handler

    ' If we are using timers, set the timer name and start time variable
    ' values.
    If mblncTimer Then
        mvarTimerName = TimerName
        mvarTimerStart = Timer
    End If

    On Error Resume Next
    Exit Function

    MsgBox Err.Number & " " & Err.Description, vbCritical, "StartTimer()"
    Resume Exit_Proc

End Function

Public Function EndTimer()
' This procedure stops the timer, collects information about the results,
' and then writes it to a file.
On Error GoTo Err_Handler

    Dim strFile As String
    Dim strContent As String

    If mblncTimer Then
        ' Build the log file name - a text file in the same folder as
        ' this project, like \project folder\project name TimerLog.txt.
        strFile = CurrentProject.Path & "\" _
        & Left(CurrentProject.Name, InStr(1, CurrentProject.Name, ".") - 1) _
        & "TimerLog.txt"

        ' If the timer log does not exist yet, start the file with column
        ' headers.
        If Len(Dir(strFile)) > 0 Then
            ' File is there already.  Do nothing.
            ' Build the header.
            strContent = _
            "Timestamp" & vbTab & _
            "TimerName" & vbTab & _

            ' Write to the log file.
            WriteTextFile strFile, strContent
        End If

        ' Build the tab-delimited content and write it to the file.
        strContent = Now() & vbTab & mvarTimerName & vbTab _
            & (Timer - mvarTimerStart, "0.000000")
        WriteTextFile strFile, strContent
    End If

    On Error Resume Next
    Exit Function

    MsgBox Err.Number & " " & Err.Description, vbCritical, "EndTimer()"
    Resume Exit_Proc

End Function

Private Function WriteTextFile(FileName As String, Content As String) _
    As Boolean
' This function writes/appends the Content to the FileName file.
' Example:
' WriteTextFile "C:\Program Files\InvoicingDB\InvoicingDB TimerLog.txt", _
    Now() & vbTab & mvarTimerName & vbTab _
    & Format(Timer - mvarTimerStart, "0.000000")
On Error GoTo Err_Handler

    Dim intFileNum As Integer

    ' Get a free file.
    intFileNum = FreeFile
    ' Open the file for appending.
    Open FileName For Append As #intFileNum
    ' Append the content.
    Print #intFileNum, Content

    WriteTextFile = True

    On Error Resume Next
    Close #intFileNum
    Exit Function

    MsgBox Err.Number & " " & Err.Description, vbCritical, _
    WriteTextFile = False
    Resume Exit_Proc
End Function



Making Microsoft Access Work

No matter what your MS Access needs are, Carl can provide live help to make sure you get the solution you need.