I want to run a Macro in Outlook at a certain time and so I'm using the Outlook Reminders to do it. I have written the below code, which successfully runs the Macro but after it has finished the If statement, it then pops up the reminder which I don't need to see and so therefore need to close/dismiss it.
Public Sub Application_Reminder(ByVal Item As Object)
If Item.Subject = "Refresh Data Test" Then
Call RunExcelMacros.TestRun
End If
End Sub
Please can someone help suggest how I can dismiss the reminder?
Okay, I think I've got it - the below seems to work, all code is setup in the "ThisOutlookSession" Module:
Private WithEvents OutlookReminders As Outlook.Reminders
Public Sub Application_Reminder(ByVal Item As Object)
Set OutlookReminders = Outlook.Reminders
If Item.Subject = "Refresh Data Test" Then
Call RunExcelMacros.TestRun
End If
End Sub
Private Sub OutlookReminders_BeforeReminderShow(Cancel As Boolean)
Dim OutlookReminder As Reminder
'After the "Application_Reminder" has run it will then run this code straight after which stops the reminder from actually popping up
For Each OutlookReminder In OutlookReminders
If OutlookReminder.Caption = "Refresh Data Test" Then
If OutlookReminder.IsVisible Then
OutlookReminder.Dismiss
Cancel = True
End If
Exit For
End If
Next OutlookReminder
End Sub
Related
I have VBA code in Outlook that adds a calendar event in a google calendar when the event is added in Outlook. The code is also able to delete an event in a google calendar when the event is deleted from Outlook.
I have this code at the top of the VBA code:
Dim WithEvents curCal As Items
Dim WithEvents DeletedItems As Items
Dim newCalFolder As Outlook.Folder
The private sub that adds an event looks like this:
Private Sub curCal_ItemAdd(ByVal Item As Object)
Dim cAppt As AppointmentItem
Dim moveCal As AppointmentItem
....
Item.Save
End Sub
The code that deletes an event looks like this:
Private Sub DeletedItems_ItemAdd(ByVal Item As Object)
' only apply to appointments
If Item.MessageClass <> "IPM.Appointment" Then Exit Sub
' if using a category on copied items, this may speed it up.
If Item.Categories = "moved" Then Exit Sub
...
End Sub
Both of these functions work as expected.
Now I need to code a sub that will execute when the event is modified so I can send the modifications to google.
I assume I need to create Private Sub curCal_xxxxxxxxxxxxxxx(ByVal Item As Object) but I dont know what the xxxxxxxxxxxxxxx would be.
Anybody know what the sub name should be where I can place code that will execute after an Outlook calendar event has been changed?
You may consider using the ItemChange event which is fired when an item in the specified collection is changed:
Private Sub myOlItems_ItemChange(ByVal Item As Object)
Dim prompt As String
If VBA.Format(Item.Start, "h") >= "17" And Item.Sensitivity <> olPrivate Then
prompt = "Appointment occurs after hours. Mark it private?"
If MsgBox(prompt, vbYesNo + vbQuestion) = vbYes Then
Item.Sensitivity = olPrivate
Item.Display
End If
End If
End Sub
But there is no information what exactly has been changed, only the item changed is passed as a parameter.
For that reason you may consider handling the AppointmentItem.PropertyChange event which is fired when an explicit built-in property (for example, Subject) of an instance of the parent object is changed. In that case the name of the property that was changed is passed as a parameter.
Also you may find the MailItem.Write event helpful. It is fired when an object is saved, either explicitly (for example, using the Save or SaveAs methods) or implicitly (for example, in response to a prompt when closing the item's inspector).
Public WithEvents myItem As Outlook.MailItem
Private Sub myItem_Write(Cancel As Boolean)
Dim myResult As Integer
myItem = "The item is about to be saved. Do you wish to overwrite the existing item?"
myResult = MsgBox(myItem, vbYesNo, "Save")
If myResult = vbNo Then
Cancel = True
End If
End Sub
Public Sub Initialize_Handler()
Const strCancelEvent = "Application-defined or object-defined error"
On Error GoTo ErrHandler
Set myItem = Application.ActiveInspector.CurrentItem
myItem.Save
Exit Sub
ErrHandler:
MsgBox Err.Description
If Err.Description = strCancelEvent Then
MsgBox "The event was cancelled."
End If
End Sub
Once I read new mails from a specific sender I would like to move them from the Inbox to a subfolder.
I set Outlook to mark mails as read as soon as I open them. To make sure I can read through the mail I want to move the mail only when I close it/change to a different mail. (Note that I'm using the reading pane.)
I tried the Explorer.SelectionChange event but it triggers multiple times when I change to a new mail.
Private WithEvents expl As Outlook.Explorer
Private Sub Application_Startup()
Set expl = Application.ActiveExplorer()
End Sub
Private Sub expl_SelectionChange()
MsgBox "Selection changed"
End Sub
Why does this trigger multiple times?
How do I get a reference to the mail item I'm "closing"?
Why does this trigger multiple times?
I guess (I could be wrong), it is because of the View that you have. The above said behaviour was not noticed for RPO or Preview mode. When you have, say, a Compact view the selection change happens two times? First when the item is selected and the 2nd time when the item contents are displayed. But like I said, I could be wrong...
Alternative
It would have been easier if Outlook had Application.EnableEvents = False like MS Excel. Hope this alternative helps?
Option Explicit
Private WithEvents expl As Outlook.Explorer
Dim DisableEvents As Boolean
Private Sub Application_Startup()
Set expl = Application.ActiveExplorer()
End Sub
Private Sub expl_SelectionChange()
If DisableEvents = True Then
DisableEvents = False
Exit Sub
End If
MsgBox "Selection changed"
DisableEvents = True
End Sub
The script below works great but I have to manually run the Initialize_handler routine every time I open Outlook for it to work.
Public WithEvents myOlApp As Outlook.Application
Public Sub Initialize_handler()
Set myOlApp = CreateObject("Outlook.Application")
End Sub
Private Sub myOlApp_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim prompt As String
prompt = "Are you sure you want to send " & Item.Subject & "?"
If MsgBox(prompt, vbYesNo + vbQuestion, "Sample") = vbNo Then
Cancel = True
End If
End Sub
As far as I can see to make this work automatically I should be able to add the below script to ThisOutlookSession. However this doesn't work and I have no idea why.
My macro security is set properly and it is running the code on startup but for some reason it doesn't work until I manually open the VBA editor click into Initialize_handler and press F5.
Private Sub Application_Startup()
Initialize_handler
End Sub
The convoluted method described here https://msdn.microsoft.com/en-us/library/office/ff865076.aspx indicates "The sample code must be placed in a class module".
I suggest you use the special class module ThisOutlookSession only. You could experiment with your own class module but if you just want this to work then replace all your code with this in ThisOutlookSession.
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim prompt As String
prompt = "Are you sure you want to send " & Item.Subject & "?"
If MsgBox(prompt, vbYesNo + vbQuestion, "Sample") = vbNo Then
Cancel = True
End If
End Sub
You can instead put it directly in ThisOutlookSession:
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
MsgBox "Sent somthing!"
End Sub
As simple as that. Note you need to change your outMail.Display to outMail.Display (True) and there you are, full code:
...
...
...
outMail.Display (True)
On Error Resume Next
bSent = outMail.sent 'This will NOT SEND. Used to get error.
If Err <> 0 Then
'Email was sent. Put followed actions here.
Else
'Email was not sent. Put followed actions here.
End If
On Error GoTo 0
Pros:
You get what you want
It's simple.
Cons:
Excel (or any other runtime you are running this code from) will freeze until you cancel or send email.
I would like to automatically run a macro when an appointment is updated.
For my test, I wish this macro displays the subject of the appointment.
You want the ItemChange event http://msdn.microsoft.com/en-us/library/office/ff865866%28v=office.14%29.aspx
Public WithEvents myOlItems As Outlook.Items
Public Sub Application_Startup()
Set myOlItems = _
Application.GetNamespace("MAPI").GetDefaultFolder(olFolderCalendar).Items
End Sub
Private Sub myOlItems_ItemChange(ByVal Item As Object)
debug.print item.subject
End Sub
This can be done by creating a rule in Outlook, and will start a macro. If you have your macro working right, then you need only set the rule. First:
Sub Sub_name(MyMail As MailItem)
'Working Code
End Sub
Then, set the condition to "which is a meeting invitation or update", actions are "run a script" Check on it, then click on the "script" link and select Sub_name.
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?
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?
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
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