What function executes in VBA when changing a calendar event - vba

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

Related

Opening Outlook conversations without marking them as read using the VBA MarkAsUnread function

Assume you grouped your Outlook messages by conversation. How to prevent any mail from a conversation to get marked read when double clicking on a conversation's main header?
Code I came up with so far:
I use Application_ItemLoad to get the object of any selected mail
Then, myItem_Read to store the selected mail's UnRead property because it's not accessible yet at the time of ItemLoad
Finally, I listen on the PropertyChange event to change back any read mail to unread. However, in the else branch below the expression mySelection.Item(1).GetConversation.MarkAsUnread fails unexpectedly. From my understanding, mySelection.Item(1) selects the Conversation Header object. Then I try to obtain its Conversation object using GetConversationand call the MarkAsUnread method which should in theory mark all the conversation's messages as unread again. Just theory. And I don't know why.
1.
Public WithEvents myItem As Outlook.mailItem
Private Sub Application_ItemLoad(ByVal Item As Object)
If EventsDisable = True Then Exit Sub
If Item.Class = olMail Then
Set myItem = Item
End If
End Sub
2.
Private Sub myItem_Read()
If EventsDisable = True Then Exit Sub
unReadWhenSelected = myItem.UnRead
End Sub
3.
Private Sub myItem_PropertyChange(ByVal Name As String)
Dim mySelection As Selection
Dim oConvHeader As Outlook.ConversationHeader
Dim oConv As Outlook.Conversation
If EventsDisable = True Then Exit Sub
If Name = "UnRead" Then
If unReadWhenSelected = True And myItem.UnRead = False Then
Set mySelection = Outlook.ActiveExplorer.Selection.GetSelection(Outlook.OlSelectionContents.olConversationHeaders)
If mySelection.Count = 0 Then
myItem.UnRead = True
myItem.Save
Else
mySelection.Item(1).GetConversation.MarkAsUnread
End If
End If
End If
End Sub
Whole story for interested readers:
Let's say you wanted to open a conversation by double clicking its header without the conversation's elements getting marked as read.
I want to use Outlook E-Mails as tasks and change the meaning of a reading a mail to finishing a task. Thus, I use search folders with the option "only show unread messages". As soon as I finish a task, I just mark it read with a macro.
For all the other cases where I just want to read the mails etc. they need to remain unread.
I wrote a macro to accomplish this for single E-Mail messages which are not part of conversations. When it comes to conversations, this macro works for all its elements - but not for the first one also known as the main conversation's header entry.
Edit:
Proof-of-concept code for marking all emails in a conversation as read.
Why is this not working in my example code above?
Sub Testorino()
Dim mySelection As Selection
Set mySelection = Outlook.ActiveExplorer.Selection.GetSelection(Outlook.OlSelectionContents.olConversationHeaders)
mySelection.Item(1).GetConversation.MarkAsUnread
End Sub
Edit: MS says this shouldn't be done at all. Application.ItemLoad's items are not intended to be used again. Note the warning here: https://learn.microsoft.com/en-us/office/vba/api/outlook.application.itemload
It says:
The Item object passed in this event should not be cached for any use outside the scope of this event.
You should be able to use the Items.ItemChange and Items.Add events instead (after initially setting it to the Inbox's items) and ignore every unread change unless your macro started it.
Old Answer --> This seems to work in Outlook 2016 in the conversation view. When the item is closed, mark the conversation as unread. This way, it doesn't skip the first item as you mentioned in your comment. If this interferes with your macro, I can see if I can get it to work after opening the item, but I wasn't getting far with that.
Public WithEvents myItem As Outlook.MailItem
Dim EventsDisable As Boolean
Dim UnreadWhenSelected As Boolean
Private Sub Application_ItemLoad(ByVal Item As Object)
If EventsDisable = True Then Exit Sub
If Item.Class = olMail Then
Debug.Print ("Item_Load")
Set myItem = Item
End If
End Sub
Private Sub myItem_Close(Cancel As Boolean)
If EventsDisable = True Then Exit Sub
Debug.Print ("Item_Close")
If UnreadWhenSelected Then
' Ignore all events fired while marking the conversation as unread
EventsDisable = True
myItem.GetConversation.MarkAsUnread
EventsDisable = False
Else
' Ignore all events fired while marking the conversation as read
EventsDisable = True
myItem.GetConversation.MarkAsRead
EventsDisable = False
End If
End Sub
Private Sub myItem_Read()
If EventsDisable = True Then Exit Sub
UnreadWhenSelected = myItem.UnRead
Debug.Print ("Item_Read. Unread: " & UnreadWhenSelected)
End Sub

How to popup question, whether to flag, after pressing send button?

Is there a way to ask (popup) if I want to flag the email after I press the send button?
Use the Application.ItemSend event to display a MsgBox asking whether to flag or not.
Then as noted in this question, you'll need to listen to the Items.ItemAdd event on the Sent Items folder and call MarkAsTask on the message passed to the event handler.
So add the following code to ThisOutlookSession - use Alt + F11 to bring up the VB editor.
Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
Dim SentItems As Folder
Set SentItems = Outlook.Application.GetNamespace("MAPI").GetDefaultFolder(olFolderSentMail)
Set Items = SentItems.Items
End Sub
Private Sub Items_ItemAdd(ByVal Item As Object)
If TypeOf Item Is Outlook.MailItem Then
Dim property As UserProperty
Set property = Item.UserProperties("FlagForFollowUp")
If property Is Nothing Then Exit Sub
Item.MarkAsTask olMarkThisWeek
Item.Save
End If
End Sub
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
If TypeOf Item Is Outlook.MailItem Then
Dim prompt As String
prompt = "Would you like to flag this item?"
If MsgBox(prompt, vbYesNo + vbQuestion, "Flag item") = vbYes Then
Dim property As UserProperty
Set property = Item.UserProperties.Add("FlagForFollowUp", olYesNo)
property.Value = True
End If
End If
End Sub

Modifying email after button clicked in form getting error Object required

In ThisOutlookSession:
Private Sub objInspectors_NewInspector(ByVal Inspector As Inspector)
If Inspector.CurrentItem.Class <> olMail Then Exit Sub
Set objMyNewMail = Inspector.CurrentItem
End Sub
In form code:
Private Sub SendButton_Click()
EmailFlagger.Hide
objMyNewMail.Body = objMyNewMail.Body & EmailFlagger.Exemptions.Text
End Sub
I get the error Object required. How do I fix this?
It is not clear what line of code generates the error... Try to switch the lines of code in the Click event handler:
Private Sub SendButton_Click()
objMyNewMail.Body = objMyNewMail.Body & EmailFlagger.Exemptions.Text
EmailFlagger.Hide
End Sub
The NewInspector event is not the right place for accessing the mail item object. Use the Activate event instead. For example, in the NewInspector event handler you can subscribe to the Activate event where you can get the valid mail object.

How can I trigger an event when multiple items added at once to Outlook Folder?

I use event handlers in VBA and Outlook frequently. One of them is one which marks any item which is deleted to be marked as read.
Private Sub deletedItems_ItemAdd(ByVal Item As Object)
Application_Startup
On Error Resume Next
Item.UnRead = False
End Sub
Declared via:
Private WithEvents deletedItems As Outlook.Items
and initialized in Application_Startup as:
Dim olNameSpace As Outlook.NameSpace
Set olNameSpace = olApp.GetNamespace("MAPI")
Set deletedItems = olNameSpace.GetDefaultFolder(olFolderDeletedItems).Items
Unfortunately, this does not affect all the items if I delete multiple items at once.
Is there a way I can do something to hijack this process somehow? I looked into using the _beforeDelete event but you have to set the item correctly each time, which if I could do this problem wouldn't exist anyways.
Apparently I wasn't clear - the use case I have is when I delete messages via the delete key from my inbox, drafts, whatever.
You don't have to.
I was curious about your question so I opened up Outlook and wrote this code in ThisOutlookSession:
Private WithEvents items As Outlook.items
Public Sub SetItems()
Set items = Application.GetNamespace("MAPI") _
.GetDefaultFolder(olFolderDeletedItems) _
.items
End Sub
Private Sub items_ItemAdd(ByVal Item As Object)
Dim mail As MailItem
On Error Resume Next
Set mail = Item
Err.Clear
On Error GoTo 0
If Not mail Is Nothing Then
MsgBox mail.Subject
mail.UnRead = False
End If
End Sub
Then I ran SetItems from the immediate pane, went to my inbox and deleted a SMS message - as expected mail was Nothing. Then I deleted a single email, and got the message with the mail's subject.
When I selected two emails and hit Delete, the event was fired once for each selected email, so I saw two message boxes - it just works! :)
The Outlook API doesn't seem to offer an event which would handle all deletions at once.
i have (almost) exactly the same code and it works also for multiple items - only after sleep-mode Outlook seems to forget how to handle deleted items...
Option Explicit
Public WithEvents itDeleted As items
Private Sub Application_Startup()
Set itDeleted = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderDeletedItems).items
End Sub
Private Sub itDeleted_ItemAdd(ByVal Item As Object)
'MsgBox "deleted-sub fired" 'this only for test-purposes
If TypeOf Item Is MailItem Then
Item.UnRead = False
End If
End Sub
I think the difference in the definition of "deletedItems" is the problem; that you are not checking the mailitem-property is also not optimal.
Hope this helps,
Max

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?
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