[AccessD] Timer Class in Access

[John Colby]

Option Compare Database
Option Explicit

Function RetStr() As String
    RetStr =
"johncolbyjohncolbyjohncolbyjohncolbyjohncolbyjohncolbyjohncolbyjohncolbyjohncolbyjohncolbyjohncolbyjohncolbyjohncolbyjohncolbyjohncolbyjohncolbyjohncolbyjohncolbyjohncolbyjohncolbyjohncolbyjohncolbyjohncolbyjohncolby"
End Function
Function PassStr()

End Function
Function TestPassParam()
Dim lclsTimer As clsTimer
Dim lngCnt As Long
Dim str As String
Dim str2 As String

    Set lclsTimer = New clsTimer
    str = "johncolby"
    str2 = "marycolby"
    lclsTimer.StartTimer
    For lngCnt = 1 To 100000
        PassStr
    Next lngCnt
    Debug.Print lclsTimer.EndTimer
End Function
Function TestRetParam()
Dim lclsTimer As clsTimer
Dim lngCnt As Long
Dim str As String

    Set lclsTimer = New clsTimer
    lclsTimer.StartTimer
    For lngCnt = 1 To 100000
        str = RetStr()
    Next lngCnt
    Debug.Print lclsTimer.EndTimer
End Function
Function TestLeftStr() As Long
Dim lclsTimer As clsTimer
Dim lngCnt As Long
Dim str As String

    Set lclsTimer = New clsTimer
    lclsTimer.StartTimer
    For lngCnt = 1 To 100000
        str =
Left$("johncolbyjohncolbyjohncolbyjohncolbyjohncolbyjohncolbyjohncolbyjohncolbyjohncolby",
10)
    Next lngCnt
    TestLeftStr = lclsTimer.EndTimer
End Function
Function TimeForNext()
Dim lngCnt As Long
    For lngCnt = 1 To 100000000
    Next lngCnt
End Function
Function TimingTest()
On Error GoTo Err_TimingTest
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim strSQL As String
Dim lclsTimer As clsTimer
Dim lngLoopCnt As Long

    strSQL = "SELECT * FROM tblTimingTest WHERE TT_TimeIt = True"
    Set db = CurrentDb
    Set rst = db.OpenRecordset(strSQL)
    Set lclsTimer = New clsTimer
    With rst
        While Not .EOF
            If !TT_TimeIt Then
                lclsTimer.StartTimer
                For lngLoopCnt = 1 To !TT_LoopCnt
                    Application.Run !TT_Code
                Next lngLoopCnt
                .Edit
                !TT_Time = lclsTimer.EndTimer
                .Update
                .MoveNext
            Else
                .MoveNext
            End If
        Wend
    End With
Exit_TimingTest:
On Error Resume Next
    Set lclsTimer = Nothing
    If Not (rst Is Nothing) Then rst.Close: Set rst = Nothing
    If Not (db Is Nothing) Then db.Close: Set db = Nothing
Exit Function
Err_TimingTest:
        MsgBox Err.Description, , "Error in Function basTest.TimingTest"
        Resume Exit_TimingTest
    Resume 0    '.FOR TROUBLESHOOTING
End Function

On Fri, Mar 4, 2022 at 1:31 PM Arthur Fuller <fuller.artful at gmail.com>
wrote:

> With the recent demise of my main laptop, I seem to have lost my copy of
> John Colby's Timer class. JWC, or anyone else with a copy, please send it
> to me privately.
> Thanks!
>
> --
> Arthur
> --
> AccessD mailing list
> AccessD at databaseadvisors.com
> https://databaseadvisors.com/mailman/listinfo/accessd
> Website: http://www.databaseadvisors.com
>


-- 
John W. Colby
Colby Consulting