SetTimer and Application.OnTime

Given a choice between API functions and VBA objects that provide similar functionality, I tend to use VBA objects (for reliability reasons), but today I want to show you two ways to do something at a certain time.

These are the API functions SetTimer and KillTimer. SetTimer sets the Sub TimerProc(ByVal hwnd As LongPtr, ByVal uMsg As LongPtr, ByVal idEvent As LongPtr, ByVal dwTime As LongPtr) to run, while KillTimer does the opposite, unsetting it.

In the parameters of SetTimer, hwnd is a handle number. As those of you who have programmed Win32 APIs will know, a handle is the equivalent of an object's social security number. In Win32 API programming, you often need a handle to do something, because you need something to do something to. Application.hwnd is the Application, which is Excel if you're working in Excel, or Word if you're working in Word.

nIDEvent is the ID of the timer, which doesn't mean much. uElapse is the interval between executions of the next procedure, which is in 1/1000th of a second, so if you give 1000, you get a 1-second interval. lpTimerFunc is a pointer to the procedure to run. In VBA, the AddressOf operator returns the address of the procedure.

' Win32 Library for VBA (32bit/64bit)
#If VBA7 Then '// 64 bit 오피스인 경우
 Public Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, _
    ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
 Public Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
 Public Declare PtrSafe Function GetQueueStatus Lib "user32" (ByVal fuFlags As Long) As Long 
#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
 Public Declare Function GetQueueStatus Lib "user32" (ByVal fuFlags As Long) As Long
#End If

'// time interval(1초=1000 이므로 100은 100/1000초가 됨)
Public Const TIMER_INTERVAL As Long = 1000  

'// Timer ID(아무 숫자나 상관없음 타이머를 여러개 사용할때 아이디만 다르게 하면 됨)
Public Const TIMER_ID As Long = 3100       
    
Dim n As Long

'// 타이머 시작, 1000& = 1초
Sub StartTimer()  
  n = 1
  StopTimer
  SetTimer Application.hwnd, TIMER_ID, TIMER_INTERVAL, AddressOf TimerProc
End Sub

'// 타이머 종료
Sub StopTimer() 
  KillTimer Application.hwnd, TIMER_ID
End Sub

Sub TimerProc(ByVal hwnd As LongPtr, ByVal uMsg As LongPtr, _
  ByVal idEvent As LongPtr, ByVal dwTime As LongPtr)
  If GetQueueStatus(QS_INPUT) <> 0 Then DoEvents
  Debug.Print n; Now
  If n >= 8 Then StopTimer
  n = n + 1
End Sub

If you want to use Application.OnTime to perform an action at a certain time, you would write something like the code below. Notice that the name of the procedure to be executed is given as a string, and the procedure that uses Application.OnTime calls itself, so the desired action should be written below it. Also, unlike API functions, OnTime is used to both set and disable the time, and the Schedule parameter is set to False when disabling.

Sub StartOnTime()
  Dim TimeInterval As Date
  
  TimeInterval = TimeValue("00:00:01")
  Application.OnTime Now + TimeInterval, "StartOnTime"
  n = n + 1
  Debug.Print n; Now
  If n >= 8 Then StopOnTime
End Sub

Sub StopOnTime()
  Dim TimeInterval As Date
  
  TimeInterval = TimeValue("00:00:01")
  
  On Error Resume Next
  Application.OnTime Now + TimeInterval, "StartOnTime", Schedule:=False
End Sub