SetTimer and VBA

You can use the Windows API to call setTimer() to do something a little like setTimeout in javaScript. However there are some serious gymnastics to be able to have multiple timers going at the same time. This is because setTimer can only callback a regular function (not a class), and you can't pass any arguments to it.  Here's how to hack around that.

First a warning - we use Windows API calls which are very fragile around data typing etc - so if you introduce the slightest hint of a bug, Excel will crash unpleasantly, and you will lose whatever you've done. So save regularly if you are playing around with this stuff. Note I haven't tested the 64bit versions of the code here. I don't even know if it will work. If anyone has 64bit office and you have some results to report, please let me know on the forum. Mac Office will of course not work at all.

Declare the APIS

' 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

This calls back lpTimerFunc after the given amount of milliseconds. The interesting trick we are going to play is to use the nIDEvent to identify which timer it is that we are referring to. Normally you would let setTimer generate its own id, but forcing a specific ID will help us identify the timer later

lpTimerFunc 

This is the callback function executed when time is up. Annoyingly,  it cannot be a class. It has to be a regular sub in a regular module. However, the nIDEvent is passed to it. We can use that.

killTimer

The callback will be repeatedly called every interval. To avoid that - and only execute the postponed action once - you have to kill the timer. Usually this would be done in lpTimerFunc

Create a cEventTimer class

In order to get all this under control and avoid global namespace pollution, we are going to create an instance of a cEventTimer class to manage the mechanics of setTimer. This will raise a custom event on timeout, which will signal other objects that the timer is expired and that it's time to do something. Here's the code. The .start() method kicks off the timer. Note that it uses objPtr(Me) as the nIDEvent. That means that we now have the address of the current instance of the cEventTimer class as the ID of the timer, so when it expires, we will know exactly what has expired. We also pass the address of eventTimer.timerExpire. This is the callback that gets executed on timeout and exists in the eventTimer regular module. Its function will be to execute the .finish() method, which kills this timer, and raises an event saying that we are done. It also passes any data associated with this instance that was set up when the timer was started. Ideally we would like to simply pass the address of .finish() to setTimer - but you can't. Getting over that is what this is all about.

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 is the key to making this all work. timerExpire is called back from the timeout, but we cast the nIDEvent as a cEventTimer. Remember that we used objPtr(Me) as the nIDEvent - which is the address of the instance of the cEventTimer class that has just expired. With that information, we can call its .finish() method

' 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

All the pieces so far make the reusable content, and should not need modification. Now let's move to consuming it. As a reminder, our objective was to find a way through VBA restrictions so we could
  • 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

The key points are
  • 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

Here's what a calling proc might look like, using your testClass above

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


For help and more information join our forum,follow the blog or follow me on twitter .


Comments