如何使application.reminder事件工作？

Question

我在一个类模块中有这段代码-就像在msdn和this stackoverflow thread上声明的那样

Public WithEvents objReminders As Outlook.Reminders

Private Sub Application_Startup()
    Set objReminders = Application.Reminders
End Sub

Private Sub Application_Reminder(ByVal Item As Object)
    Call Send_Email_Using_VBA
    MsgBox ("Litigate!") 
End Sub

我试过使用this thread底部的代码，但也不能启动。

所有我能得到的是outlook的提醒弹出窗口。不会命中任何断点，Msgbox也不会显示-即使我删除了函数调用。我已经重新启动了几次，但没有结果。

我是不是错过了什么重要的东西？

Answer 1

您正在使用WithEvents处理objReminders对象上的Reminder事件，但是没有声明要匹配的subs。在我下面的代码中，请注意objReminders_...与您的Application_... subs。

我在Outlook 2003中使用了您的代码(我没有Office 2007，因此无法在那里进行测试)，并提出了以下建议：

Public WithEvents objReminders As Outlook.Reminders

Private Sub objReminders_Snooze(ByVal ReminderObject As Reminder)
    Call Send_Email_Using_VBA
    MsgBox ("Litigate!")
End Sub

Private Sub Class_Initialize()
    Set objReminders = Outlook.Reminders
End Sub

在一个普通的代码模块中使用这个实现：

Sub test()

Dim rmd As New ReminderClass

rmd.objReminders.Item(1).Snooze 1 'Triggers objReminders_Snooze in class module
rmd.objReminders.Item(2).Snooze 1

End Sub

现在，这是在我显式调用的Snooze事件上触发的。但是，这也可以在事件第一次出现时触发(据我所知，这不会在提醒从Snooze唤醒时触发)。我没有设置任何用于测试的提醒-如果您在这方面有困难，我将设置一些我自己的测试。

Private Sub objReminders_ReminderFire(ByVal ReminderObject As Reminder)
    Call Send_Email_Using_VBA
    MsgBox ("Litigate!")
End Sub

更新：

在2010年尝试了一下之后，我发现以下方法是有效的(至少是起火了，但它似乎总是起火)：

Private Sub Application_Reminder(ByVal Item As Object)
    Call Send_Email_Using_VBA
    MsgBox ("Litigate!")
End Sub

这是在ThisOutlookSession对象模块中设置的。添加这个对你有帮助吗？

Answer 2

值得注意的是，这必须在ThisOutlookSession代码中，而不是不同的模块中

Private Sub objReminders_ReminderFire(ByVal ReminderObject As Reminder)
    Call Send_Email_Using_VBA
    MsgBox ("Litigate!")
End Sub

Answer 3

此问题的实际答案如下:如果您正在设置定期约会，并将代码放在约会的Application_Reminder事件中，则提醒事件将不会触发，除非您在约会本身的下拉列表中专门设置了提醒期间。

我玩了几天，这个事件永远不会触发，除非它是一个单一的约会-重复从来不会起作用。

设置一个定期预约，提醒时间为5分钟，一切都很顺利。

仅供参考这里是一些代码，我使用存储在本地文件夹中的电子邮件模板每月发送用户信息(自我密码重置)提醒。现在可以完美工作了。记得创建你自己的新类别，如果发送的自动电子邮件称为链接‘发送邮件’。每个约会都必须设置为此类别，并在Sub中选中。

    Private Sub Application_Reminder(ByVal Item As Object)
      Dim objMsg As MailItem

       On Error Resume Next


    'IPM.TaskItem to watch for Task Reminders
    If Item.MessageClass <> "IPM.Appointment" Then
      Exit Sub
    End If

    If Item.Categories <> "Send Mail" Then
      Exit Sub
    End If

     'Check which Template for Reminder we need to send by looking for the keyword in the Reminder Appointment

If InStr(Item.Subject, "e-Expenses Password Resets") > 0 Then
    Set objMsg = Application.CreateItemFromTemplate("C:\Reminder Emails\e-Expenses Resetting your own password.oft")

ElseIf InStr(Item.Subject, "e-Learning Password Resets") > 0 Then
    Set objMsg = Application.CreateItemFromTemplate("C:\Reminder Emails\e-Learning Resetting your own password.oft")

ElseIf InStr(Item.Subject, "EMIS Password Resets") > 0 Then
    Set objMsg = Application.CreateItemFromTemplate("C:\Reminder Emails\EMIS Web Resetting your own password.oft")

ElseIf InStr(Item.Subject, "NHS email Password Resets") > 0 Then
    Set objMsg = Application.CreateItemFromTemplate("C:\Reminder Emails\NHS Net eMail Resetting your own password.oft")

ElseIf InStr(Item.Subject, "STRATA Password Resets") > 0 Then
    Set objMsg = Application.CreateItemFromTemplate("C:\Reminder Emails\STRATA Resetting your own password.oft")

ElseIf InStr(Item.Subject, "VPN Password String Resets") > 0 Then
    Set objMsg = Application.CreateItemFromTemplate("C:\Reminder Emails\VPN Resetting your own password.oft")

Else: Exit Sub

End If

 'Location is the email address we send to, typically to ALL users
  objMsg.To = Item.Location
  objMsg.Subject = Item.Subject  'Make the subject of the Appointment what we want to say in the Subject of the email
  objMsg.Send


  Set objMsg = Nothing
End Sub

玩得开心。

戴夫·托马斯