Avatar of Lawrence Salvucci
Lawrence Salvucci
Flag for United States of America asked on

Delete Outlook Calendar Appointments

I am trying to delete all my Outlook Calendar Appointments within a specific date range. But I don't want to delete any appointments that are set to a recurrence since they could be in the future. I found this code online and it works good except that it will delete the recurrence appointments too. Can anyone help me modify this to NOT include recurrence appointments? My VBA skills are terrible and even worse with Outlook.

Private Function DeleteAppts()
Dim strCurrent As String
Dim objApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim objFolder As Outlook.MAPIFolder
Dim objItems As Outlook.Items
Dim objItem As Object
Dim strStart As String
Dim strEnd As String
Dim strFilter As String
'put required start and end dates into strStart and strEnd respectively
'if they are constants then just set them before this
'I created textboxes for users to input the dates themselves
strStart = "09/15/2016 07:00 AM"
strEnd = "09/15/2016 16:00 PM"
'create a string to use to filter the outlook items
strFilter = "[Start] >= " & Quote(strStart) & " And [Start] < " & Quote(strEnd)
'set the outlook objects and specify the items in the calendar using the filter
Set objApp = CreateObject("Outlook.Application")
Set objNS = objApp.GetNamespace("MAPI")
Set objFolder = objNS.GetDefaultFolder(olFolderCalendar)
Set objItems = objFolder.Items.Restrict(strFilter)
Set objItem = objItems.GetFirst
intCount = objItems.Count
For i = intCount To 1 Step -1
    Set objItem = objItems(i)

'clears out outlook objects from memory
Set objApp = Nothing
Set objNS = Nothing
Set objFolder = Nothing
Set objItems = Nothing
Set objItem = Nothing
MsgBox "Items Deleted!"
End Function

Function Quote(MyText) As String

    Quote = Chr(34) & MyText & Chr(34)

End Function

Open in new window


Avatar of undefined
Last Comment
Tarmo Kabonen

8/22/2022 - Mon
Tarmo Kabonen

View this solution by signing up for a free trial.
Members can start a 7-Day free trial and enjoy unlimited access to the platform.
See Pricing Options
Start Free Trial
Ask your own question & get feedback from real experts
Find out why thousands trust the EE community with their toughest problems.
Experts Exchange has (a) saved my job multiple times, (b) saved me hours, days, and even weeks of work, and often (c) makes me look like a superhero! This place is MAGIC!
Walt Forbes