Outlook macros for travel time and notifying someone you are out of the office automatically

Lately we have had some questions from employees wanting to automatically add travel time to their calendars. After some research and links from them I came across a script written here that was modified at the bottom of the page for adding in 2 separate times as well as working for meetings and appointments. I modified a few things on it to make sure there was no buffer time as well and then decided to add in one more thing.

Our office uses a global calendar mailbox called Out that they can send a meeting request to stating they will be out of the office so that our Admin team knows easily and from one calendar who is here and who is not. The downside is users forget, so I made a script to automatically send a request to that mailbox (or whatever mailbox you wish) as soon as someone saves an appointment or meeting with the Out Of Office status.

Enjoy!




Dim WithEvents olkCalendar As Outlook.Items


Private Sub Application_Quit()
    Set olkCalendar = Nothing

End Sub

Private Sub Application_Startup()
    Set olkCalendar = Session.GetDefaultFolder(olFolderCalendar).Items

    Const OLK_TRAVEL_SCRIPT_NAME = "Schedule Travel Time"
    Const OLK_INVITE_SCRIPT_NAME = "Notify FAST Team"
End Sub

Private Sub olkCalendar_ItemAdd(ByVal Item As Object)
    If Item.BusyStatus = OlBusyStatus.olOutOfOffice Then
        If MsgBox("Do you need to schedule travel time for this meeting?", vbQuestion + vbYesNo, OLK_TRAVEL_SCRIPT_NAME) = vbYes Then
            CreateTravelAppointmentEntry Item           'setup TO travel time
            CreateTravelAppointmentEntry Item, False    'setup FROM travel time
        End If
        If MsgBox("Do you need to nofity the FAST Team of your absense?", vbQuestion + vbYesNo, OLK_INVITE_SCRIPT_NAME) = vbYes Then
            CreateFastAppointmentEntry Item           'Notify FAST Team
        End If
    End If
End Sub

Private Sub CreateTravelAppointmentEntry(ByVal Item As Object, Optional ByVal isTo As Boolean = True)
    Dim olkTravel As Outlook.AppointmentItem
    Dim intMinutes As Integer

    intMinutes = InputBox("How many minutes " & IIf(isTo, "to", "from") & "?", OLK_TRAVEL_SCRIPT_NAME, 15)
    If intMinutes > 0 Then
        Set olkTravel = Application.CreateItem(olAppointmentItem)
        With olkTravel
            'Edit the subject as desired'
            .Subject = "Travel " & IIf(isTo, "to", "from") & " Meeting: " & Item.Subject
       
            If isTo Then
                .Start = DateAdd("n", intMinutes * -1, Item.Start)
            Else
                .Start = DateAdd("n", 0, Item.End)
            End If
       
            .End = DateAdd("n", intMinutes, .Start)
            .Categories = Item.Categories
            .BusyStatus = olBusy
            .Save
        End With
    End If

    Set olkTravel = Nothing
End Sub

Private Sub CreateFastAppointmentEntry(ByVal Item As Object, Optional ByVal isTo As Boolean = True)
   
    Dim olkInvite As Outlook.AppointmentItem
    Dim intMeetingLength As Integer

    Set olkInvite = Application.CreateItem(olAppointmentItem)
    With olkInvite
        .MeetingStatus = olMeeting
        .Subject = "Out of Office"
        .Start = Item.Start
        .End = Item.End
        .Categories = Item.Categories
        .BusyStatus = olBusy
        'Edit below line with your email address to send to'
        .RequiredAttendees = "out@epicsysinc.com"
        .Send
    End With

    Set olkInvite = Nothing

End Sub

An Outlook Quirk

I discovered a slight bug recently when designing a new signature for our company that I would never had caught in a million years of troubleshooting and is testament to how hard it is to make a perfect application/design.

After setting up tables, images, fighting outlooks lack of support for certain layouts in versions previous to 2013 I thought I had done it all. I checked, printed, sent and printed some more and everything was in great shape. Then I roll out to my first beta group, and man did something so strange happen.

Our CEO has multiple monitors and as such small print can definitely be hard to see way out in the corners, so he has increased the OS rendering 125%. I've seen people do this before, but I have never seen it effect Outlook like it has now. He runs 2013, and every time he sends an email out with the new signature 2 of the 4 images increase in size by 25%. We have compared them to the others, and can not find anything different. It's amazing but so frustrating at the same time. I have yet to find a solution to this issue other than changing the screen back to 100%, but there has to be something that's different....right?

Well after a few hours of prodding I was able to figure it out. The issue seems to only happen when the image has Inline Word Wrapping turned on. Setting it to Top/Bottom seems to fix the image blowup for good.