How do I make the application.reminder event work?

问题

I have this code in a class module - as stated to on msdn and on 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

I have tried using the code at the bottom of this thread and 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.

Am I missing something important?

回答1:

You are using WithEvents to handle your Reminder events on the objReminders object, but you are not declaring the subs to match. In my code below, please note the objReminders_... vs. your Application_... subs.

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:

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 Snooze event, 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.

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):

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

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

回答2:

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

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

回答3:

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.

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.

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.

    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

来源：https://stackoverflow.com/questions/11544779/how-do-i-make-the-application-reminder-event-work

标签

events

vba

outlook

outlook-vba