Home » excel » vba – Timer functions and generating events with a callback

vba – Timer functions and generating events with a callback

Posted by: admin April 23, 2020 Leave a comment


I need a better way of raising events than the SetTimer API in user32.dll.

Have you used the other timer APIs successfully? Do you know another way of raising events or calling a function asynchronously in Excel?

What do I mean by ‘better’? I need something that can pop messages off of an internally-maintained queue, asynchronously. The problem is that items are being pushed onto the queue by an external data source (Reuters market data) that raises its ‘Data Update’ events with messages in the WM_Application range; SetTimer works by sending WM_Timer messages, the seven-stone weakling of Windows Messaging, and my ‘Pop’ process never gets a chance to run, even in relatively light traffic.

If you have suggestions for a better architecture, feel free to offer them: but an incoming data update event absolutely MUST go to an event ‘sink’, as fast as possible – Excel will crash if too many events (or callbacks) are raised while some long, slow process is handling the last event, and the one before that. My queue has a finite size, because there’s only a few hundred stocks in the application: an incoming data update can either peek and update an existing item, if it’s an updated price for a stock that’s already in the queue, or push a new stock’s ticker and price onto the queue. So no pricing data is ever dropped because we’re busy, and clean coding for the push and peek functions means that the event sink is fast enough to ensure that Excel remains stable.

But I’m left looking for a better way of popping items off the queue.

Unfortunately all the other timer APIs I’ve tried don’t seem to work in VBA: they crash the application or freeze code execution. Here’s the list (hyperlinks lead to the MSDN documentation):

  1. CreateTimerQueueTimer Lib “Kernel32.dll”
  2. CreateWaitableTimer Lib “kernel32”
  3. TimeSetEvent Lib “winmm.dll”

I suspect that the problems I had with these functions are nothing to do with bad syntax on my part: I don’t know the windows threading model well enough to say what actually happens when they call back, but the documentation on one of them states that ‘This callback function must not call the TerminateThread function’ and I take that to mean that VBA cannot ‘sink’ an event raised with that particular timer API.

Take it as read that I know the correct API calls to Kill or delete these timers and their associated queues: space is limited and the Waitable Timer uses separate Create-, Set-, Cancel- and CloseHandle API calls. And the TimerProc functions all have slightly different signatures.

Here’s the standard SetTimer function call:

lngTimerID = SetTimer(hWndXL, VBA.ObjPtr(Me), lngInterval, AddressOf TimerProc)

I won’t bore you with the TimerProc function declaration and a digression about delegation: if you can answer this question, you’ve seen all the relevant code samples already.

I look forward to your replies: I have a running application, and careful coding and segregation means that the internal data lag is acceptable. But I’d like to think that I could do better, even if I’m limited to delivering a standalone Excel Workbook.

How to&Answers:

I’m not 100% with what your trying to do, but the timer APIs will let you asynchronously “schedule” a function call, but the callback won’t execute asynchronously of course as its all happening on the same thread.

That said, any of the callback timer APIs should work in VBA, for example (using n-instances->single callback):

Timer Module

Public Const TIME_PERIODIC As Long = 1
Public Declare Function CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As Any, src As Any, ByVal length As Long) As Long
Public Declare Function timeKillEvent Lib "winmm.dll" (ByVal uID As Long) As Long
Public Declare Function timeSetEvent Lib "winmm.dll" (ByVal uDelay As Long, ByVal uResolution As Long, ByVal lpFunction As Long, ByVal dwUser As Long, ByVal uFlags As Long) As Long

Public Sub tmrCallback(ByVal uID As Long, ByVal uMsg As Long, ByVal dwUser As Long, ByVal dw1 As Long, ByVal dw2 As Long)
    If (dwUser = 0) Then
        timeKillEvent uID
        Exit Sub
    End If

    Dim IDisp As Object
    Dim Obj As Class1

    CopyMemory IDisp, dwUser, 4&
    Set Obj = IDisp
    CopyMemory IDisp, 0&, 4&
End Sub


Private MYHTIMER As Long
Public Name As String

Private Sub stopTmr()
    If (MYHTIMER) Then timeKillEvent MYHTIMER
End Sub

Private Sub Class_Initialize()
    MYHTIMER = timeSetEvent(1000, 0, AddressOf Module1.tmrCallback, ObjPtr(Me), TIME_PERIODIC Or TIME_CALLBACK_FUNCTION)
End Sub

Private Sub Class_Terminate()
End Sub

Public Sub TimerMethod()
    Static lCntr    As Long: lCntr = lCntr + 1
    Debug.Print "In " & Me.Name & ".TimerMethod()", "#"; lCntr, CLng(Timer - StartTime) & "secs"
    If (lCntr = 2) Then TestBlockThreadFor5Secs
    If (lCntr >= 3) Then stopTmr
End Sub


Public A As Class1
Public B As Class1

Sub test()
    Set A = New Class1: A.Name = "inst1"
    Set B = New Class1: B.Name = "inst2"
End Sub

Sub TestBlockThreadFor5Secs()
    Debug.Print "**blocking"
    t = Timer:
    Do Until Timer - t = 5: Loop
End Sub


In inst1.TimerMethod()      # 1           1secs
In inst2.TimerMethod()      # 1           1secs
In inst1.TimerMethod()      # 2           2secs
In inst1.TimerMethod()      # 3           7secs
In inst2.TimerMethod()      # 2           7secs
In inst2.TimerMethod()      # 3           12secs