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

Question

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

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

有一个叫做的事件Application_Reminder.它在outlook中每次出现提醒时运行.但这仍然涉及用户互动.我想要一个完整的后端程序.

Answer 1

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

将以下代码放在ThisOutlookSession模块中(工具 - >宏 - > VB编辑器):

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)此定时器功能不要求特定窗口打开; 它在后台运行

2)如果在应用程序关闭时没有停用计时器,它可能会崩溃

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

4)如果您没有看到msgbox指示计时器在启动时已激活,则您的宏安全性设置得太高

5)在时间间隔的一次迭代之后使计时器停用添加:如果TimerID <> 0则在子TriggerTimer中的msgbox语句之后调用DeactivateTimer

其他人建议

"需要注意的一点是,如果你没有检查TimerID是否与TriggerTimer中的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

Answer 2

对于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