vba 如何使 application.reminder 事件起作用？

How do I make the application.reminder event work?

提问by Citrus Rain

I have this code in a class module - as stated to on msdnand on this stackoverflow thread

我在类模块中有此代码 - 如msdn和此 stackoverflow 线程所述

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

I have tried using the code at the bottom of this threadand that won't launch either.

我曾尝试使用此线程底部的代码，但也无法启动。

All I can get is outlook's reminders popup. No breakpoints are ever hit, the Msgbox never shows - even if I remove the function call. I have restarted it several times and I have no result.

我所能得到的只是 Outlook 的提醒弹出窗口。没有断点被击中，Msgbox 永远不会显示 - 即使我删除了函数调用。我已经重新启动它几次，我没有结果。

Am I missing something important?

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

回答by Gaffi

You are using WithEventsto handle your Reminderevents on the objRemindersobject, but you are not declaring the subs to match. In my code below, please note the objReminders_...vs. your Application_...subs.

您正在使用WithEvents来处理对象Reminder上的事件objReminders，但您没有声明要匹配的子项。在我下面的代码中，请注意objReminders_...vs. 你的Application_...潜艇。

I played with your code in Outlook 2003 (I do not have Office 2007, so I cannot test there), and came up with the following:

我在 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

Implemented with this in a normal code module:

在普通代码模块中使用此实现：

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

Now, this is triggering on the Snoozeevent, which I explicitly call. However, this should also work for you to trigger when the event first comes up (this does not, as far as I can tell, trigger when a reminder wakes from a Snooze). I did not have any reminders set up to test - if you have difficulties beyond this, I will set up a few of my own tests with regard to that.

现在，这是在Snooze我明确调用的事件上触发的。但是，这也应该适用于您在事件首次出现时触发（据我所知，这不会在提醒从 a 唤醒时触发Snooze）。我没有设置任何提醒来测试 - 如果您有其他困难，我将为此设置一些我自己的测试。

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

---

---

Update:

更新：

After playing around with this in 2010, I found the following to work (at least fire, but it seemed to constantly fire):

在 2010 年玩弄这个之后，我发现以下工作（至少火，但它似乎不断火）：

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

This was set up in the ThisOutlookSessionobject module. Does adding this do anything for you?

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

回答by David Bollman

It's worth noting that this must be in the ThisOutlookSession code, not a different module

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

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

回答by dave thomas

The actual ANSWER to this question is the following: If you are setting recurring appointments, and putting code in the Application_Reminder event on an appointment, the Reminder event will NOT fire unless you specifically set a Reminder period in the drop down within the Appointment itself.

这个问题的实际答案如下：如果您正在设置定期约会，并将代码放入约会的 Application_Reminder 事件中，除非您在约会本身的下拉列表中明确设置提醒期，否则提醒事件不会触发。

I played with this for days, the event would never fire unless it was a single Appointment - recurring never worked.

我玩了几天，除非它是单个约会，否则该事件永远不会触发 - 重复从未奏效。

Setting a recurring appointment with a Reminder time of 5 minutes and all is working perfectly.

设置重复约会，提醒时间为 5 分钟，一切正常。

FYI here is some code that I use to send user information (self password reset) reminders on a monthly basis, using email templates stored in a local folder. Works perfectly now. Remember to create your own new category if sending auto-emails called something linke 'Send Mail'. Each appointment must be set to this category and is checked within the Sub.

仅供参考，这里有一些代码，我使用存储在本地文件夹中的电子邮件模板每月发送用户信息（自行重置密码）提醒。现在完美运行。如果发送名为“发送邮件”链接的自动电子邮件，请记住创建您自己的新类别。每个约会都必须设置为此类别，并在 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

Have fun.

玩得开心。

Dave Thomas

戴夫·托马斯