' windows api timer functions
#If VBA7 And WIN64 Then
' 64-bit
Public Declare PtrSafe Function SetTimer Lib "user32" ( _
ByVal HWnd As LongLong, ByVal nIDEvent As LongLong, _
ByVal uElapse As LongLong, _
ByVal lpTimerFunc As LongLong) As LongLong
Public Declare PtrSafe Function KillTimer Lib "user32" ( _
ByVal HWnd As LongLong, _
ByVal nIDEvent As LongLong) As LongLong
#Else
'32-bit
Public Declare Function SetTimer Lib "user32" ( _
ByVal HWnd As Long, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As Long) As Long
Public Declare Function KillTimer Lib "user32" ( _
ByVal HWnd As Long, _
ByVal nIDEvent As Long) As Long
#End If
settimer
lpTimerFunc
killTimer
Create a cEventTimer class
Option Explicit
' this class relies on eventTimer.timerExpire to call back .finish()
Public Event expired(data As Variant)
Private pData As Variant
Public Sub start(ms As Long, Optional data As Variant)
' it will call timerexpire in the eventtimer module when done - that should call .finish()
pData = data
SetTimer Application.HWnd, ObjPtr(Me), ms, AddressOf eventTimer.timerExpire
End Sub
Public Function finish() As Long
' kill the timer associated with this object
KillTimer Application.HWnd, ObjPtr(Me)
' raise a regular event so that whoever is relying on me can work
' any data passed when started will be passed on to event
RaiseEvent expired(pData)
End Function
Create an eventTimer.timerExpire sub
' this timerExpire is called when the cEventTimer class times out
' the timer id used is actually the objptr(ceventtimer)
' that way, what will arrive is the address of the cEventTimer object disguised as a setTimer ID
#If VBA7 And WIN64 Then
Public Sub timerExpire(ByVal HWnd As LongLong, ByVal uMsg As LongLong, _
ByVal timer As cEventTimer, ByVal dwTimer As LongLong)
#Else
Sub timerExpire(ByVal HWnd As Long, ByVal uMsg As Long, _
ByVal timer As cEventTimer, ByVal dwTimer As Long)
#End If
If Not timer Is Nothing Then
timer.finish
End If
End Sub
Putting it all together
- call something back after a period of time
- pass arguments to it
- run multiple timers at the same time
- call back specific instances of classes
Each of those points has been enabled by the code above. Now let’s apply an example. Let’s say you have a class, and you want it to be signalled after a period of time – testClass. In its simplest form it would look like this
Option Explicit
Private WithEvents pEventTimer As cEventTimer
Private Sub Class_Initialize()
Set pEventTimer = New cEventTimer
End Sub
Public Sub execute(ms As Long, Optional data As Variant)
pEventTimer.start ms, data
End Sub
Private Sub pEventTimer_expired(data As Variant)
Debug.Print "ive been called back with this data:" & CStr(data)
End Sub
- a reference to an instance of a cEventTimer with events so that you will be signalled when it raises an event
- start the timer
- gets called back (with your data) when expired. Instead of (or as well as) passing the data via the event timer, you could also store some data in this instance of the class for later use. It’s in this expired callback that you would do whatever it is you were waiting for, and perhaps restart the timer for the next thing.
Initiating
Public Sub testIt()
Dim tClass As testClass
Set tClass = New testClass
' need to keep it in memory
keepInMemory tClass
' wait 1 sec then report im done
tClass.execute 1000, "im done"
' do something else in the meantime
Debug.Print "could be doing something else"
End Sub
And the output
could be doing something else
ive been called back with this data:im done
A-note-on-keeping-the-object-in-memory
One problem with calling an instance of a class in VBA is that it will be garbage collected when the procedure exits. What would happen then is that the expired event would never be signalled – or rather the object that would have received the signal would no longer be there and therfore nothing would happen when the timer expired. That is, unless there is a persistent reference to your class. One way to do this would be to stick Private tClass as testClass at the beginning of your module instead of in your Sub. The problem with that is that you would need to know in advance how many you would need – which kind of defeats part of the objective.
I usually keep a collection of things I would like to stay in memory in a public object. By making a reference to them there, they stick around. Not only that, I also have a central register of what needs to be torn down to recover the memory. It’s very simple – just put this code at the beginning of some module. Anything you want to persist, just use keepInMemory someObject
Public register As cDeferredRegister
Public Function keepInMemory(o As Object) As Object
Set keepInMemory = o
If register Is Nothing Then Set register = New cDeferredRegister
register.register o
End Function
The cDeferredRegister class is in the downloadable workbook associated with Promises in VBA, which is still at the early stages of development. Here is the current version, used with the above
Option Explicit
' when doing asynchronous things, local variables can go out of scope and be garbage collected
' the purpose of this class is to register an interest in local variables so they dont
' and instance of this class should be declared at module level so it stays in scope when your proc exits
' doing it this way avoids lots of global variables
Private pInterests As Collection
Public Sub teardown()
Dim c As Variant, n As Long, i As Long
n = pInterests.Count
For i = 1 To n
Set c = pInterests(1)
tryToTearDown (c)
Set c = Nothing
pInterests.Remove (1)
Next i
End Sub
Public Function register(c As Variant) As Variant
pInterests.add c, CStr(ObjPtr(c))
Set register = c
End Function
Private Function tryToTearDown(c As Variant) As Boolean
' this will try to execute a teardown if it has one
On Error GoTo failed
c.teardown
tryToTearDown = True
Exit Function
failed:
tryToTearDown = False
End Function
Private Sub Class_Initialize()
Set pInterests = New Collection
End Sub