An Outlook user wanted to forward messages that were not replied to within a specific period of time. If the messages were still unreplied to later, he wanted to forward them to a different address.
To do this you need to check the last verb property (PR_LAST_VERB_EXECUTED) using propertyaccessor. If the last verb is not 102 (reply) or reply all (103) then check the received date. If it's older than 7 days then forward to address1; if older than 3 days, forward to address2. (By checking for older messages first, we avoid forwarding the same message to address2 a second time.)
More propertyaccessors for email can be found at Read MAPI properties not exposed in Outlook's Object Model
This macro runs only when you run it, but you could use the method described at Send an email when an Appointment reminder fires to trigger it using a reminder.
To change the folder the macro checks, see Working with VBA and non-default Outlook Folders. As written it checks the default Inbox but it can check in any folder, including a shared mailbox's Inbox.
Sub ForwardAgedMail() Dim objOutlook As Outlook.Application Dim objNamespace As Outlook.NameSpace Dim objSourceFolder As Outlook.MAPIFolder Dim objVariant As Variant Dim intCount As Integer Dim intDateDiff As Integer Dim propertyAccessor As Outlook.propertyAccessor Dim myForward As Outlook.MailItem 'On Error Resume Next Set objOutlook = Application Set objNamespace = objOutlook.GetNamespace("MAPI") Set objSourceFolder = objNamespace.GetDefaultFolder(olFolderInbox) ' use a subfolder under Inbox For intCount = objSourceFolder.Items.Count To 1 Step -1 Set objVariant = objSourceFolder.Items.Item(intCount) DoEvents If objVariant.Class = olMail Then Set propertyAccessor = objVariant.propertyAccessor If Not propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x10810003") = 102 _ And Not propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x10810003") = 103 Then intDateDiff = DateDiff("d", objVariant.SentOn, Now) ' I'm using 7 days, adjust as needed. If intDateDiff > 7 Then 'forward message Set myForward = objVariant.Forward myForward.To = "email@example.com" myForward.Display ElseIf intDateDiff > 3 Then Set myForward = objVariant.Forward myForward.To = "firstname.lastname@example.org" myForward.Display ' .send End If End If End If Next End Sub
Don't count weekends
Removing weekends (or holidays) from the count is more difficult. If the date span is 5 business days, this snippet should work. It checks the sent date and adds 2 to account for the weekend days.
Dim sentDate As Date sentDate = objVariant.SentOn Select Case Weekday(sentDate, vbUseSystemDayOfWeek) Case vbSunday sentDate = DateAdd("d", 1, sentDate) Case vbSaturday sentDate = DateAdd("d", 2, sentDate) Case vbFriday sentDate = DateAdd("d", 2, sentDate) Case vbThursday sentDate = DateAdd("d", 2, sentDate) Case vbWednesday sentDate = DateAdd("d", 2, sentDate) Case vbTuesday sentDate = DateAdd("d", 2, sentDate) Case vbMonday sentDate = DateAdd("d", 2, sentDate) End Select intDateDiff = DateDiff("d", sentDate, Now)
How to use macros
First: You will need macro security set to low during testing.
To check your macro security in Outlook 2010 or 2013, go to File, Options, Trust Center and open Trust Center Settings, and change the Macro Settings. In Outlook 2007 and older, it’s at Tools, Macro Security.
After you test the macro and see that it works, you can either leave macro security set to low or sign the macro.
Open the VBA Editor by pressing Alt+F11 on your keyboard.
To put the code in a module:
- Right click on Project1 and choose Insert > Module
- Copy and paste the macro into the new module.
More information as well as screenshots are at How to use the VBA Editor
To view the last verb and last verb executed time in your email folders, see How to display the sender's email address in Outlook.
This macro is based off of the macro at Use a Macro to Move Aged Email in Outlook
DateDiff Function (Visual Basic) (MSDN)