Sub AddTravel()
Dim olItem As AppointmentItem
Dim olTravel As AppointmentItem
Dim strTravel As String
Dim iTravelMinutes As Integer
    strTravel = InputBox("Enter the travel time in minutes for each journey", "Travel Time", 60)
    If IsNumeric(strTravel) Then
        iTravelMinutes = Val(strTravel)
        Set olItem = ActiveExplorer.Selection.Item(1)
        If olItem.Class = olAppointment Then
            Set olTravel = CreateItem(olAppointmentItem)
            With olTravel
                .MeetingStatus = olNonMeeting
                .Subject = "Travel to " & olItem.Subject
                .Start = DateAdd("n", -iTravelMinutes, olItem.Start)
                .Duration = iTravelMinutes
                .Save
            End With
            Set olTravel = CreateItem(olAppointmentItem)
            With olTravel
                .MeetingStatus = olNonMeeting
                .Subject = "Return travel from " & olItem.Subject
                .Start = olItem.End
                .Duration = iTravelMinutes
                .Save
            End With
        End If
    End If
lbl_Exit:
    Set olItem = Nothing
    Set olTravel = Nothing
    Exit Sub
End Sub