Activate Out of Office reply

Question

I would like to automate my Out of Office based on the days that I'll be out on a biweekly basis. I don't have access to the Exchange server that hosts our Outlook.

I set an Outlook rule to send a automatic reply on Monday and apply VBA code to disable this rule when I'm in the office (with Outlook open). This is not an elegant way because the rule sends a reply to the user repeatedly every time an email is sent to me.

How can I activate my Out of Office reply on Outlook 2010 using VBA?

Here are the two resources I used: https://answers.microsoft.com/en-us/msoffice/forum/msoffice_outlook-mso_win10/set-up-recurring-out-of-office-auto-reply-for/71dd1fef-ba99-4a2b-be72-7d509e8848eb

https://superuser.com/questions/292426/outlook-2010-how-to-turn-out-of-office-on-automatically-when-outlook-is-closed

This is the script I have in "ThisOutlookSession" to enable/disable the rule, "HomeTime" containing my Out Of Office-like message.

Option Explicit

Private Sub Application_Quit()
    SetRuleEnabled True
End Sub

Private Sub Application_Startup()
    SetRuleEnabled False
End Sub

Private Sub SetRuleEnabled(ByVal bEnable As Boolean)
    Dim oSession    As Outlook.NameSpace
    Dim oRule       As Outlook.Rule
    Dim oRules      As Outlook.Rules
    Dim oPA         As Outlook.PropertyAccessor

    Set oSession = Application.Session
    Set oRules = oSession.DefaultStore.GetRules()
    Set oPA = oSession.DefaultStore.PropertyAccessor

    '*** If the Out-Of-Office is already on (eg. holidays, sick leave etc.) 
    '*** then it might be best to force this rule permanently off
    If oPA.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x661D000B") Then
        bEnable = False
    End If

    For Each oRule In oRules
        If oRule.Name = "HomeTime" Then
            oRule.Enabled = bEnable
            oRules.Save
            Exit For
        End If
    Next

End Sub

AirWreck AirWreck · Accepted Answer · 2020-01-01T15:49:22

I am assuming you've checked out Om3r's link, but I have a less elegant, if not clunky solution. I once created a VBA out of office message as a practical joke (just to avoid someone). I could not find the code, but here is a summary of what you'd need to do.

(Outlook has to be running for this to work)

Create a public boolean variable, for example OutofOffice, set by a ribbon/QAT button or on a schedule.

Create and save a draft email with your message (e.g. "I am out of the office...")

Use or set up an Inbox_ItemAdd event listener, and for each incoming email:

Reply to it,

concatenating "Auto-Reply " to the subject line

Retrieve the draft email and concatenate your draft message body to the reply body (and you'll have to figure out HTMLBody versus (non-HTML) Body. Something like:

OutMail.HTMLBody = OutMail.HTMLBody & ObjDraft.HTMLBody

or you might save your OOO message as a public static string (instead of a draft email).

Send the email

as you mentioned, you don't want to repeatedly send this to people who sent you additional emails during this period. I would probably add the sender's email address (after passing to a GetSMTPAddress type function) to an array. I'd add a IsInArray type function to check each new sender (to see if they were emailed already). This array would be erased by your procedure called when you click that control again to turn off the OOO reply.

If this worked for you, of course you could create a userform to edit the OOO message and set the schedule (day of week or specific dates).

Activate Out of Office reply

1 Answers