Wintimer Problem

[Jaye7]

I have a wintimer, however occasionally it has a problem where even though I cancel the timer it just keeps running anyway and the only way I have found to stop it is to close the file and re-open it otherwise the timer will not function properly as it is like now there are two timers running which confuse each other, does anyone have a suggestion on how to fix this problem without having to close my workbook.

The script I use to end the timer follows.

Sub EndTimer()
    'On Error Resume Next
    KillTimer 0&, TimerID
end sub

 

[Jaafar Tribak]

You need to make sure that the TimerID variable is seen by EndTimer sub by declaring it as a module level or Public variable.Also, the project must not lose state or be reset as the timer handle stored in the TimerID variable will then be lost .

A safer approach that I tend to use is to associate the timers with the hwnd of a window within the current Process. Doing this will ensure that the Timers don't rely on variables that can be accidently lost and will ensure that the timers are always properly terminated.

Try this example :

Option Explicit

Private Declare Function SetTimer Lib "user32" _
(ByVal hWnd As Long, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As Long) As Long
 
Private Declare Function KillTimer Lib "user32" ( _
ByVal hWnd As Long, _
ByVal uIDEvent As Long) As Long
 

Private Declare Function FindWindowEx Lib "user32" _
Alias "FindWindowExA" _
(ByVal hwnd1 As Long, _
ByVal hwnd2 As Long, _
ByVal lpsz1 As String, _
ByVal lpsz2 As String) As Long



Sub StartTimers()

    'Timer 1
     Call SetTimer(Application.hWnd, 0, 1000, AddressOf TimerProc1)
     
    'Timer 2
    Call SetTimer((FindWindowEx(Application.hWnd, 0, "XLDESK", vbNullString)), _
     0, 2000, AddressOf TimerProc2)
 

End Sub

Sub StopTimers()

    KillTimer Application.hWnd, 0
    KillTimer (FindWindowEx(Application.hWnd, 0, "XLDESK", vbNullString)), 0
    Debug.Print "Timers stopped."
    
End Sub


Private Function TimerProc1( _
    ByVal hWnd As Long, _
    ByVal uMsg As Long, _
    ByVal idEvent As Long, _
    ByVal dwTime As Long _
)
     Debug.Print "Timer1 running: " & Format(Now, "hh:mm:ss")

End Function

Private Function TimerProc2( _
    ByVal hWnd As Long, _
    ByVal uMsg As Long, _
    ByVal idEvent As Long, _
    ByVal dwTime As Long _
)
     Debug.Print "Timer2 running: " & Format(Now, "hh:mm:ss")

End Function

 

[Jaye7]

Thanks Jaafar, I will give it a go.