Macro to automatically add travel time in Outlook 2013

Macro to automatically add travel time in Outlook 2013

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
End Sub

Private Sub olkCalendar_ItemAdd(ByVal Item As Object)
    Const SCRIPT_NAME = "Schedule Travel Time"
    Dim olkTravel1 As Outlook.AppointmentItem, _
        olkTravel2 As Outlook.AppointmentItem, _
        intMinutes As Integer
    If Item.MeetingStatus = olMeeting Then
        If msgbox("Do you need to schedule travel time for this meeting?", vbQuestion + vbYesNo, SCRIPT_NAME) = vbYes Then
            intMinutes = InputBox("How many minutes each way?", SCRIPT_NAME, 15)
            If intMinutes > 0 Then
                Set olkTravel1 = Application.CreateItem(olAppointmentItem)
                With olkTravel1
                    'Edit the subject as desired'
                    .Subject = "Travel to Meeting: " & Item.Subject
                    .Start = DateAdd("n", intMinutes * -1, Item.Start)
                    .End = Item.Start
                    .Categories = Item.Categories
                    .BusyStatus = olBusy
                    .Save
                End With
                Set olkTravel2 = Application.CreateItem(olAppointmentItem)
                With olkTravel2
                    'Edit the subject as desired'
                    .Subject = "Travel from Meeting: " & Item.Subject
                    .Start = Item.End
                    .End = DateAdd("n", intMinutes, Item.End)
                    .Categories = Item.Categories
                    .BusyStatus = olBusy
                    .Save
                End With
            End If
        End If
    End If
    Set olkTravel1 = Nothing
    Set olkTravel2 = Nothing
End Sub


Macro to automatically add travel time in Outlook 2013

Leave a Reply

Your email address will not be published. Required fields are marked *