How do I make the application.reminder event work?

匿名 (未验证) 提交于 2019-12-03 09:06:55

问题:

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



标签
易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!