可以将文章内容翻译成中文,广告屏蔽插件可能会导致该功能失效(如失效,请关闭广告屏蔽插件后再试):
问题:
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