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 settimerThis 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 lpTimerFuncThis 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. killTimerThe 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 classIn 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 subThis 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 togetherAll 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
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
InitiatingHere'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 outputcould be doing something else ive been called back with this data:im done A note on keeping the object in memoryOne 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
For help and more information join our forum,follow the blog or follow me on twitter . |
Services > Desktop Liberation - the definitive resource for Google Apps Script and Microsoft Office automation > Classes > Promises in VBA >