troubleshooting Question

Delete Outlook Calendar Appointments

Avatar of Lawrence Salvucci
Lawrence SalvucciFlag for United States of America asked on
Outlook
1 Comment1 Solution147 ViewsLast Modified:
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()
'Declarations
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)
    objItem.Delete
Next

'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
ASKER CERTIFIED SOLUTION
Tarmo Kabonen
IT Services

Our community of experts have been thoroughly vetted for their expertise and industry experience.

Join our community to see this answer!
Unlock 1 Answer and 1 Comment.
Start Free Trial
Learn from the best

Network and collaborate with thousands of CTOs, CISOs, and IT Pros rooting for you and your success.

Andrew Hancock - VMware vExpert
See if this solution works for you by signing up for a 7 day free trial.
Unlock 1 Answer and 1 Comment.
Try for 7 days

”The time we save is the biggest benefit of E-E to our team. What could take multiple guys 2 hours or more each to find is accessed in around 15 minutes on Experts Exchange.

-Mike Kapnisakis, Warner Bros