Vacation Reminders


 

A reader named Jasmine contacted me last week with an interesting request. Jasmine’s office maintains a shared Outlook calendar used to keep track of vacations. They’d like the ability to send an employee an email a few days before they go on vacation reminding them to change their voice-mail message. Each vacation entry consists of an appointment on the shared calendar. The subject of each appointment uses the form “XXX vacation” where “XXX” is the employee’s initials. Jasmine asked if I could build something that would do this automatically. Here is the solution I put together for her.

I wrote the solution in VBScript so it can run from a scheduled task (i.e. a task in Windows Task Scheduler). When the task executes it will run the script. The script will open Outlook, connect to the shared calendar, retrieve all the appointments for the day X days from now (Jasmine will set the value of X), look through those appointments to find the vacation entries (it identifies them by the word “vacation” appearing in the subject), then create and send a reminder to each vacation entry it found. Because Jasmine’s office uses initials to identify each employee, the script uses a file Jasmine will build to match an employee’s initials to their email address.

Instructions.

Here’s what Jasmine will need to do to use the solution.

  1. Create a new text file.
  2. In the new text file enter the initials and email address of each employee in the form XXX,YYY where XXX is the employee’s initials and YYY is the employee’s email address. Be sure there’s no space before or after the comma separating the initials from the address. Each entry goes on a separate line.
  3. Save the text file. Jasmine may name it anything she wants. She will need to remember where the file is and what she named it.
  4. Open Notepad.
  5. Copy the code below and paste it into Notepad.
  6. Edit the code per the comments I included in it. Jasmine will need to provide the Outlook folder path to the shared calendar, the name and path to the initials file created in step #1, the number of days in advance of an employee going on vacation to send the reminder message, the reminder message’s subject and body.
  7. Save the file to disk. Jasmine can name it anything she wants as long as the file extension is .vbs.
  8. Create a task in Windows Task Scheduler.
  9. Set the task’s action to run this script.
  10. Set the task to run once a day.
  11. Set the task to run in the context of an account with an Outlook profile that has access to the shared calendar.
'--> Create some constants
'On the next line edit the path to the calendar containing the vacation entries
Const CALENDAR_PATH = "Outlook Data File\Calendar"
'On the next line edit the path to the file containing the initials and corresponding email addresses
Const INITIALS_FILE = "C:\Users\David\Documents\TestArea\Initials.txt"
'On the next line edit the number of days in advance of vacation you want the messages to go out.
Const DAYS_IN_ADVANCE = 5
'On the next line edit the subject of the messages.  This is the subject that will appear on all vacation warning messages.
Const MSG_SUBJECT = "Some subject goes here"
'On the next line edit the body of the messages.  This is the body that will appear in all vacation warning messages.
Const MSG_BODY = "Some message goes here"
Const olMailItem = 0
Const olFormatHTML = 2

'--> Create some variables
Dim olkApp, olkSes, olkFld, olkLst, olkApt, olkMsg, datStart, datEnd, dicInitials

'--> Initialize some variables
datStart = DateAdd("d", DAYS_IN_ADVANCE, Date) & " 12:00 AM"
datEnd = DateAdd("d", DAYS_IN_ADVANCE, Date) & " 11:59 PM"
LoadInitials

'--> Connect to Outlook
Set olkApp = CreateObject("Outlook.Application")
Set olkSes = olkApp.GetNamespace("MAPI")
olkSes.Logon olkApp.DefaultProfileName

'--> Open the shared Outlook folder
Set olkFld = OpenOutlookFolder(CALENDAR_PATH)

'--> Get the items from the folder
Set olkLst = olkFld.Items
olkLst.Sort "[Start]"
olkLst.IncludeRecurrences = True
Set olkLst = olkLst.Restrict("[Start] >= '" & datStart & "' AND [Start] <= '" & datEnd & "'")

'--> Process the items
For Each olkApt In olkLst
    If InStr(1, olkApt.Subject, "vacation") > 0 Then
        Set olkMsg = olkApp.CreateItem(olMailItem)
        With olkMsg
            .Recipients.Add LookupInitials(Left(olkApt,3))
            .Recipients.Resolveall
            .Subject = MSG_SUBJECT
            .BodyFormat = olFormatHTML
            .HTMLBody = MSG_BODY
            .Send
        End With
    End If
Next

'--> Disconnect from Outlook
olkSes.Logoff

'--> Destroy all objects
Set olkMsg = Nothing
Set olkApt = Nothing
Set olkFld = Nothing
Set olkSes = Nothing
Set olkApp = Nothing

'-- End script
WScript.Quit

Sub LoadInitials
    Dim objFSO, objFil, strBuf, arrTmp
    Set dicInitials = CreateObject("Scripting.Dictionary")
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFil = objFSO.OpenTextfile(INITIALS_FILE)
    Do Until objFil.AtEndOfStream
        strBuf = objFil.ReadLine
        arrTmp = Split(strBuf, ",")
        dicInitials.Add arrTmp(0), arrTmp(1)
    Loop
    objFil.Close
    Set objFil = Nothing
    Set objFSO = Nothing
End Sub

Function LookupInitials(strInitials)
    If dicInitials.Exists(strInitials) Then
        LookupInitials = dicInitials.Item(strInitials)
    Else
        LookupInitials = ""
    End If
End Function

Function OpenOutlookFolder(strFolderPath)
    Dim arrFolders, varFolder, bolBeyondRoot
    On Error Resume Next
    If strFolderPath = "" Then
        Set OpenOutlookFolder = Nothing
    Else
        Do While Left(strFolderPath, 1) = "\"
            strFolderPath = Right(strFolderPath, Len(strFolderPath) - 1)
        Loop
        arrFolders = Split(strFolderPath, "\")
        For Each varFolder In arrFolders
            Select Case bolBeyondRoot
                Case False
                    Set OpenOutlookFolder = olkSes.Folders(varFolder)
                    bolBeyondRoot = True
                Case True
                    Set OpenOutlookFolder = OpenOutlookFolder.Folders(varFolder)
            End Select
            If Err.Number <> 0 Then
                Set OpenOutlookFolder = Nothing
                Exit For
            End If
        Next
    End If
    On Error GoTo 0
End Function
Advertisements

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s