Public Sub AddBreakTime()
  Dim coll As VBA.Collection
  Dim obj As Object
  Dim Appt As Outlook.AppointmentItem
  Dim FreeTime As Outlook.AppointmentItem
  Dim Items As Outlook.Items
  Dim Before&, After&
  Dim Category$, Subject$

  '1. Block minutes before and after the appointment
  Before = 30
  After = 30

  If Before = 0 And After = 0 Then Exit Sub

  Set coll = GetCurrentItems
  If coll.Count = 0 Then Exit Sub
  For Each obj In coll
    If TypeOf obj Is Outlook.AppointmentItem Then
      Set Appt = obj
      If TypeOf Appt.Parent Is Outlook.AppointmentItem Then
        Set Items = Appt.Parent.Parent.Items
      Else
        Set Items = Appt.Parent.Items
      End If

      If Before > 0 Then
        Set FreeTime = Items.Add
        FreeTime.Subject = "Free Time"
        FreeTime.Start = DateAdd("n", -Before, Appt.Start)
        FreeTime.Duration = Before
        FreeTime.Save
      End If

      If After > 0 Then
        Set FreeTime = Items.Add
        FreeTime.Subject = "Free Time"
        FreeTime.Start = Appt.End
        FreeTime.Duration = After
        FreeTime.Save
      End If
    End If
  Next
End Sub

Private Function GetCurrentItems(Optional IsInspector As Boolean) As VBA.Collection
  Dim coll As VBA.Collection
  Dim Win As Object
  Dim Sel As Outlook.Selection
  Dim obj As Object
  Dim i&

  Set coll = New VBA.Collection
  Set Win = Application.ActiveWindow

  If TypeOf Win Is Outlook.Inspector Then
    IsInspector = True
    coll.Add Win.CurrentItem
  Else
    IsInspector = False
    Set Sel = Win.Selection
    If Not Sel Is Nothing Then
      For i = 1 To Sel.Count
        coll.Add Sel(i)
      Next
    End If
  End If
  Set GetCurrentItems = coll
End Function