Going on Vacation with Outlook
On the Outlook Team Blog there's a useful article about setting up your Outlook for the times you're away. It doesn't provide any code samples, however, and you might want to manage your office status programmatically.
There's two things we want to cover here: setting your Out Of Office status, and updating your calendar so anyone who checks can see that you're away (i.e. not available for meetings).
Note that the code that sets up the appointments doesn't work the same way as the Outlook Team Blog post describes. Their suggestion is to send a meeting request to the people you deal with, mark the time as Free (so they can still schedule "real" meetings with others while you're away) and request no meeting responses.
This is a kludgy workaround that's unnecessary, not to mention overcomplicated. First, you never know who might try to schedule you for a meeting. Setting your own calendar is a defensive posture that prevents anyone from doing so, without having to "hardcode" the potential requestor(s). Sending a meeting request to a few people only prevents them from scheduling you; anyone else is still free to do so.
Second, you shift the burden of remembering that you're away to others by cluttering up their calendar views with your "show time as free" meeting.
That's why I don't understand why they would call this method "least intrusive." I find it's better to set your own calendar to show you're out of office.
Copy the entire code below into a standard module in your Outlook VB IDE. Run from a toolbar button or just press Alt-F8.
On Error GoTo ErrorHandler
Dim StartDate As Date
Dim EndDate As Date
Dim i As Long
' set up out of office msg
Call SetOutOfOffice
' ask for vacation days
StartDate = CDate(InputBox("Enter the first day of your vacation, " & _
"in the format: mm/dd/yyyy"))
EndDate = CDate(InputBox("Enter the last day of your vacation, " & _
"in the format: mm/dd/yyyy"))
' set up all day "appointments" for each weekday
For i = StartDate To EndDate
If IsWeekday(i) Then
Call SetAllDayAppt(i)
End If
Next i
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.number & " - " & Err.Description
Resume ProgramExit
End Sub
Function SetOutOfOffice(Optional OOOStatus As Boolean = True, _
Optional OOOText As String = "I'm currently out of the office.")
Dim ms As Object
' requires CDO 1.21
Set ms = CreateObject("MAPI.Session")
' set out of office status
ms.OutOfOffice = OOOStatus
' if we are out, then set/change message text
If OOOStatus Then
ms.OutOfOfficeText = OOOText
End If
End Function
Function SetAllDayAppt(vacationDate As Long)
Dim olApp As Outlook.Application
Dim appt As Outlook.AppointmentItem
Set olApp = GetOutlookApp
Set appt = olApp.CreateItem(olAppointmentItem)
With appt
.Start = vacationDate
.AllDayEvent = True
.Subject = "On Vacation"
.ReminderSet = False
.BusyStatus = olOutOfOffice
.Save
End With
End Function
Function GetOutlookApp() As Outlook.Application
Set GetOutlookApp = Outlook.Application
End Function
Function IsWeekday(vacationDate As Long) As Boolean
' returns True if given date is Saturday or Sunday
IsWeekday = (Weekday(vacationDate, vbMonday) < 6)
End Function
The first thing we do is call the custom function SetOutOfOffice which creates a MAPI.Session object. You'll need to have CDO 1.21 installed on the target computer. (If you don't have it, download it using the link.)
After turning on Out Of Office, we ask the user for start and end vacation dates. These must be, respectively, the first and last vacation dates that the user will be away. You should not start or end on a date that you will be in the office.
We loop through the dates (using a Long variable representing the date value) and, if the date is a weekday, we create an all-day appointment on that date. Since it's an all-day event, we only need to specify the start date, turn off reminders (we won't be around to see them), and change the busy status so that anyone who tries to schedule us for a meeting will see that we're away. It is assumed that you will be out of the office weekends; if you do work weekends, first of all you have my sympathies. The code will need to be edited.
For more about programming with CDO, some excellent code samples and links can be found at OutlookCode.
