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 timer, 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
    Else
        CalcHoursOrMinutes = lngMinutes
    End If
EndTimer

The section 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 columns, 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.

Code:

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

Exit_Proc:
    On Error Resume Next
    Exit Function

Err_Handler:
    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.
        Else
            ' Build the header.
            strContent = _
            "Timestamp" & vbTab & _
            "TimerName" & vbTab & _
            "ElapsedTime"

            ' 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 _
            & Format(Timer - mvarTimerStart, "0.000000")
        WriteTextFile strFile, strContent
    End If

Exit_Proc:
    On Error Resume Next
    Exit Function

Err_Handler:
    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

Exit_Proc:
    On Error Resume Next
    Close #intFileNum
    Exit Function

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

Download:

basTimerLog.zip