I have wanted a way to do code profiling in VBA for quite some time.
It becomes very complicated to figure out what methods are actually being executed for how long and how often in complex Access applications. A key reason this is complicated is that many form events or function calculations happen very often and not only as the result of code. Form events fire based on other form events or user input, etc.
This is a basic class I am calling Profiler:
Option Compare Database
Option Explicit
Private initTime As Double
Private mProfiledMethod As String
Public Property Let ProfiledMethod(pValue As String)
mProfiledMethod = pValue
End Property
Private Sub Class_Initialize()
initTime = GetTickCount
End Sub
Private Sub Class_Terminate()
GetProfileManager.addMethodCall mProfiledMethod, GetTickCount() - initTime
End Sub
Here is what I am calling a ProfileManager class:
Option Compare Database
Option Explicit
Private m_MethodTotalTimes As Scripting.Dictionary
Private m_MethodTotalCalls As Scripting.Dictionary
Public Sub addMethodCall(p_method As String, p_time As Double)
If m_MethodTotalTimes.exists(p_method) Then
m_MethodTotalTimes(p_method) = m_MethodTotalTimes(p_method) + p_time
m_MethodTotalCalls(p_method) = m_MethodTotalCalls(p_method) + 1
Else
m_MethodTotalTimes.Add p_method, p_time
m_MethodTotalCalls.Add p_method, 1
End If
End Sub
Public Sub PrintTimes()
Dim mKey
For Each mKey In m_MethodTotalTimes.Keys
Debug.Print mKey & " was called " & m_MethodTotalCalls(mKey) & " times for a total time of " & m_MethodTotalTimes(mKey)
Next mKey
End Sub
Private Sub Class_Initialize()
Set m_MethodTotalTimes = New Scripting.Dictionary
Set m_MethodTotalCalls = New Scripting.Dictionary
End Sub
Here is my main module example. I have several nested methods.
Public Declare Function GetTickCount Lib "kernel32.dll" () As Long
Private mProfileManager As profileManager
Public Function GetProfileManager() As profileManager
If mProfileManager Is Nothing Then
Set mProfileManager = New profileManager
End If
Set GetProfileManager = mProfileManager
End Function
Public Sub resetProfileManager()
Set mProfileManager = Nothing
End Sub
Sub mainProfilerTest()
'reinit profile manager
resetProfileManager
'run some time/tests
test1
'print results
GetProfileManager.PrintTimes
End Sub
Sub test1()
Dim mProfiler As New Profiler
mProfiler.ProfiledMethod = "test1"
Dim i As Long
For i = 0 To 100
test2
Next i
End Sub
Sub test2()
Dim mProfiler As New Profiler
mProfiler.ProfiledMethod = "test2"
test3
test4
End Sub
Sub test3()
Dim mProfiler As New Profiler
mProfiler.ProfiledMethod = "test3"
Dim i As Long, j As Long
For i = 0 To 1000000
j = 1 + 5
Next i
End Sub
Sub test4()
Dim mProfiler As New Profiler
mProfiler.ProfiledMethod = "test4"
Dim i As Long, j As Long
For i = 0 To 500000
j = 1 + 5
Next i
End Sub
This works alright. I will have to add the two lines of code to create/init each Profiler
at the beginning of any method I want to profile, which is not ideal but not terribly awful.
On my machine the raw output is:
test3 was called 101 times for a total time of 640
test4 was called 101 times for a total time of 390
test2 was called 101 times for a total time of 1030
test1 was called 1 times for a total time of 1030
For actual runtime, I am intending on wrapping a ProfileManager
over a simple sub which triggers form events. For example I might make a simple sub to Open a form, but do something like:
resetProfileManager
DoCmd.OpenForm "Form Name"
GetProfileManager.PrintTimes
Which will print out all the profiled methods for all the tracked methods.
Alternatively, I can reset the profile manager in the background and mimic user behavior and retrieve the profile at any time in the intermediate window with:
?GetProfileManager.PrintTimes
I am basically looking for feedback on how to make this better. It is pretty rough currently because I don't want to go through all the methods I'd want to profile and start adding this code without having more eyes on this.