Delete all appointments from a range of dates

Topic

New Reply

Is there an add in or code to do this? If so is there a way to code it to remove the recurring appointmnets but only for those days?
Thanks

Reply | Quote

Replies

The following code hopefully does what you want – I haven’t actually tested it, not wanting to delete any appointments.
I’d create a backup of your .pst file before testing.
Please read the note after the code.

Code:

Sub DeleteAppointments(dtStart As Date, dtEnd As Date)
  Dim olNsp As Outlook.NameSpace
  Dim strStart As String
  Dim strEnd As String
  Dim olAppts As Outlook.Items
  Dim curAppt As Outlook.AppointmentItem
  Dim i As Long

  On Error GoTo ErrHandler

  Set olNsp = GetNamespace("MAPI")
  strStart = Format(dtStart, "mm/dd/yyyy") & " 12:00 AM"
  strEnd = Format(dtEnd, "mm/dd/yyyy") & " 11:59 PM"

  Set olAppts = olNsp.GetDefaultFolder(olFolderCalendar).Items
  olAppts.Sort "Start"
  olAppts.IncludeRecurrences = True
  Set olAppts = olAppts.Restrict _
	("[Start] >= """ & strStart & """ And [Start] <= """ & strEnd & """")
  For i = olAppts.Count To 1 Step -1
	olAppts.Item(i).Delete
  Next i

ExitHandler:
  Set curAppt = Nothing
  Set olAppts = Nothing
  Set olNsp = Nothing
  Exit Sub

ErrHandler:
  MsgBox Err.Number & " " & Err.Description, vbExclamation
  Resume ExitHandler
End Sub

Note: if your system uses dd/mm/yyyy date format, replace both occurrences of mm/dd/yyyy in the code with dd/mm/yyyy.

Reply | Quote