This might be helpful. Put the following into a standard module:
Private Declare Function CreateTimerQueue Lib "kernel32.dll" () As Long
Private Declare Function DeleteTimerQueue Lib "kernel32.dll" _
(ByVal TimerQueue As Long) As Long
Private Declare Function CreateTimerQueueTimer Lib "kernel32.dll" _
(ByRef phNewTimer As Long, ByVal TimerQueue As Long, _
ByVal Callback As Long, ByVal Parameter As Long, _
ByVal DueTime As Long, ByVal Period As Long, _
ByVal Flags As Long) As Long
Private Declare Function DeleteTimerQueueTimer Lib "kernel32.dll" _
(ByVal TimerQueue As Long, ByVal Timer As Long, _
ByVal CompletionEvent As Long) As Long
Private Const WT_EXECUTEDEFAULT = &H0 'By default, the
callback function
'is queued to a non-I/O
worker thread.
Private Const WT_EXECUTEINIOTHREAD = &H1 'The callback function
is queued to an
'I/O worker thread.
'This flag should be
used if the function
'should be executed in a
thread that waits
'in an alertable state.
The callback
'function is queued as
an APC. Be sure to
'address reentrancy
issues if the function
'performs an alertable
wait operation.
Private Const WT_EXECUTEINUITHREAD = &H2
Private Const WT_EXECUTEINWAITTHREAD = &H4 'The callback function
is invoked by the
'wait thread itself.
This flag should be
'used only for short
tasks or it could
'affect other wait
operations. Deadlocks
'can occur if some other
thread acquires an
'exclusive lock and
calls the UnregisterWait
'or UnregisterWaitEx
function while the
'callback function is
trying to acquire the
'same lock.
Private Const WT_EXECUTEONLYONCE = &H8 'The timer will be set
to the signaled state
'only once.
Private Const WT_EXECUTELONGFUNCTION = &H10 'The callback function
can perform a long
'wait. This flag helps
the system to decide
'if it should create a
new thread.
Private Const WT_EXECUTEINTIMERTHREAD = &H20 'The callback function
is invoked by the
'timer thread itself.
This flag should be
'used only for short
tasks or it could affect
'other timer operations.
The callback
'function is queued as
an APC. It should not
'perform alertable wait
operations.
Private Const WT_EXECUTEINPERSISTENTIOTHREAD = &H40
Private Const WT_EXECUTEINPERSISTENTTHREAD = &H80 'The callback function
is queued to a thread
'that never terminates.
It does not guarantee
'that the same thread is
used each time. This
'flag should be used
only for short tasks or
'it could affect other
timer operations. Note
'that currently no
worker thread is truly
'persistent, although no
worker thread will
'terminate if there are
any pending I/O
'requests.
'Private Const WT_TRANSFER_IMPERSONATION = 6 'Callback functions will
use the current
'access token, whether
it is a process or
'impersonation token. If
this flag is not
'specified, callback
functions execute only
'with the process token.
Windows XP and
'Windows 2000: This flag
is only supported
'on Windows XP SP2 or
later, and Windows
'Server 2003 or later.
Private hQueue As Long
Private hTimer As Long
Private iCounter As Integer
Private iMaxCount As Integer
Public Sub BeginTimer(lPeriod As Long, Optional iIterations As Integer = -1)
'Programmable timer
'Author: Graham R Seach
'Date: 16 June 2004
'Inputs: lPeriod - Timer event period (in milliseconds)
' iIterations - The number of times to fire the timer event.
' - A value of -1 causes the timer to continue until
'manually' stopped
'
'IMPORTANT: When testing this module, ensure that you have a way of cleanly
terminating the
'timer, that does not rely on entering "EndTimer" in the Immediate Window
after BeginTimer
'has been executed. This is because, depending on the timer interval, you
may not have time
'to type "EndTimer" and hit the <Enter> key, before the next Debug.Print
statement is
'encountered.
'
iCounter = 1
iMaxCount = IIf(iIterations < 0, -1, IIf(iIterations = 0, 1,
iIterations))
If hTimer = 0 Then
'Create the queue
hQueue = CreateTimerQueue()
'Create the timer
Call CreateTimerQueueTimer(hTimer, _
hQueue, _
AddressOf TimerCallBack, _
ByVal 0&, _
lPeriod, _
IIf(iIterations = 0 Or iIterations = 1, 0,
lPeriod), _
WT_EXECUTEDEFAULT Or WT_EXECUTELONGFUNCTION)
Else
'Something prevented the timer from closing, so close it.
EndTimer
End If
End Sub
Public Sub EndTimer()
'Delete the timer
DeleteTimerQueueTimer hQueue, hTimer, ByVal 0&
'Delete the queue
DeleteTimerQueue hQueue
'Reset the variables
hTimer = 0: hQueue = 0
End Sub
Private Sub TimerCallBack(ByVal lpParameter As Long, ByVal TimerOrWaitFired
As Long)
'Do whatever is required here.
'Debug.Print iCounter
'Only stop when the count reaches the maximum.
'If the timer has been set to run continuously,
'iMaxCount will be -1. Therefore, iCounter will
'never equal iMaxCount, so the timer will run
'forever.
If iCounter = iMaxCount Then
EndTimer
Debug.Print "End"
Else
'Only increment the counter if iMaxCount > 0
If iMaxCount > 0 Then iCounter = iCounter + 1
Debug.Print "Event fired!"
End If
End Sub
Regards,
Graham R Seach
Microsoft Access MVP
Sydney, Australia
Microsoft Access 2003 VBA Programmer's Reference
http://www.wiley.com/WileyCDA/WileyTitle/productCd-0764559036.html