Outlook VBA – 每半小时运行一次代码

我想每半小时在Outlook(VBA)中运行一个特定的代码。

代码运行时outlook用户也不应该受到干扰。 它应该只在后端运行。

有一个名为Application_Reminder的事件。 它在每次发生提醒时都会运行。 但是这仍然涉及用户交互。 我想要一个完整的后端程序。

http://www.outlookcode.com/threads.aspx?forumid=2&messageid=7964

将下面的代码放在ThisOutlookSession模块(Tools-> Macros-> VB Editor)中:

 Private Sub Application_Quit() If TimerID <> 0 Then Call DeactivateTimer 'Turn off timer upon quitting **VERY IMPORTANT** End Sub Private Sub Application_Startup() MsgBox "Activating the Timer." Call ActivateTimer(1) 'Set timer to go off every 1 minute End Sub 

将下面的代码放在一个新的VBA模块中

 Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerfunc As Long) As Long Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long Public TimerID As Long 'Need a timer ID to eventually turn off the timer. If the timer ID <> 0 then the timer is running Public Sub ActivateTimer(ByVal nMinutes As Long) nMinutes = nMinutes * 1000 * 60 'The SetTimer call accepts milliseconds, so convert to minutes If TimerID <> 0 Then Call DeactivateTimer 'Check to see if timer is running before call to SetTimer TimerID = SetTimer(0, 0, nMinutes, AddressOf TriggerTimer) If TimerID = 0 Then MsgBox "The timer failed to activate." End If End Sub Public Sub DeactivateTimer() Dim lSuccess As Long lSuccess = KillTimer(0, TimerID) If lSuccess = 0 Then MsgBox "The timer failed to deactivate." Else TimerID = 0 End If End Sub Public Sub TriggerTimer(ByVal hwnd As Long, ByVal uMsg As Long, ByVal idevent As Long, ByVal Systime As Long) MsgBox "The TriggerTimer function has been automatically called!" End Sub 

关键点:

1)这个定时器function不要求一个特定的窗口打开; 它在后台工作

2)如果您在应用程序closures时不closures计时器,它可能会崩溃

3)这个例子显示定时器在启动时被激活,但它可以很容易地被不同的事件调用

4)如果您没有看到msgbox表示定时器在启动时被激活,则您的macros安全性设置得太高

5)要在定时器的一次迭代之后使定时器停用add:If TimerID <> 0然后在子TriggerTimer中的msgbox语句之后调用DeactivateTimer

别人build议

“有一点需要注意,如果你不检查TriggerTimer中TimerID是否与idevent相同,那么你经常会得到,而不是你所要求的时间。

 Public Sub TriggerTimer(ByVal hwnd As Long, ByVal uMsg As Long, ByVal idevent As Long, ByVal Systime As Long) 'keeps calling every X Minutes unless deactivated If idevent = TimerID Then MsgBox "The TriggerTimer function has been automatically called!" End If End Sub 

对于Win64,我需要将其更改为:

 Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongLong, ByVal nIDEvent As LongLong, ByVal uElapse As LongLong, ByVal lpTimerfunc As LongLong) As LongLong Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongLong, ByVal nIDEvent As LongLong) As LongLong Public TimerID As LongLong 'Need a timer ID to eventually turn off the timer. If the timer ID <> 0 then the timer is running Public Sub TriggerTimer(ByVal hwnd As Long, ByVal uMsg As Long, ByVal idevent As Long, ByVal Systime As Long) MsgBox "The TriggerTimer function has been automatically called!" End Sub Public Sub DeactivateTimer() Dim lSuccess As LongLong lSuccess = KillTimer(0, TimerID) If lSuccess = 0 Then MsgBox "The timer failed to deactivate." Else TimerID = 0 End If End Sub Public Sub ActivateTimer(ByVal nMinutes As Long) nMinutes = nMinutes * 1000 * 60 'The SetTimer call accepts milliseconds, so convert to minutes If TimerID <> 0 Then Call DeactivateTimer 'Check to see if timer is running before call to SetTimer TimerID = SetTimer(0, 0, nMinutes, AddressOf TriggerTimer) If TimerID = 0 Then MsgBox "The timer failed to activate." End If End Sub 

正确的答案为64位:

 Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongLong, ByVal nIDEvent As LongLong, ByVal uElapse As LongLong, ByVal lpTimerfunc As LongLong) As LongLong Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongLong, ByVal nIDEvent As LongLong) As LongLong Public TimerID As LongLong 'Need a timer ID to eventually turn off the timer. If the timer ID <> 0 then the timer is running Public Sub TriggerTimer(ByVal hwnd As Long, ByVal uMsg As Long, ByVal idevent As Long, ByVal Systime As Long) MsgBox "The TriggerTimer function has been automatically called!" End Sub Public Sub DeactivateTimer() Dim lSuccess As LongLong '<~ Corrected here lSuccess = KillTimer(0, TimerID) If lSuccess = 0 Then MsgBox "The timer failed to deactivate." Else TimerID = 0 End If End Sub Public Sub ActivateTimer(ByVal nMinutes As Long) nMinutes = nMinutes * 1000 * 60 'The SetTimer call accepts milliseconds, so convert to minutes If TimerID <> 0 Then Call DeactivateTimer 'Check to see if timer is running before call to SetTimer TimerID = SetTimer(0, 0, nMinutes, AddressOf TriggerTimer) If TimerID = 0 Then MsgBox "The timer failed to activate." End If End Sub