This macro deletes all cancelled meetings within two dates.
It runs against the calendar you have open and clicked on.
I would like it to run every 15 minutes against three calendars hard coded into the macro.
I have three meeting room resources, room1, room2 and room3.
Any help would be much appreciated.
Dim olkFld As Outlook.Folder, _
olkLst As Outlook.Items, _
olkItemsInDateRange As Outlook.Items, _
olkApt As Outlook.AppointmentItem, _
strRestriction As String, _
intCnt As Integer, _
intIdx As Integer, _
daStart As Date, _
daEnd As Date
'Enter a start and end date'
daStart = (DateAdd("d", -7, Date))
daEnd = (DateAdd("d", 60, Date))
'Construct a filter for the date range.
strRestriction = "[Start] >= '" & daStart _
& "' AND [End] <= '" & daEnd & "'"
'Select calendar items in current folder
intAnswer = MsgBox("Have you selected the calendar?", vbYesNo, "Wait")
If intAnswer = vbYes Then
Set olkFld = Application.ActiveExplorer.CurrentFolder
Set olkLst = olkFld.Items
'To include recurring appointments, sort by using the Start property.
olkLst.IncludeRecurrences = True
'Restrict the Items collection.
Set olkItemsInDateRange = olkLst.Restrict(strRestriction)
'Loop to count the items'
For Each olkApt In olkItemsInDateRange
intCnt = intCnt + 1
'Loop to process the items'
For intIdx = intCnt To 1 Step -1
Set olkApt = olkItemsInDateRange(intIdx)
If Left(olkApt.Subject, 9) = "Canceled:" Then
Set olkFld = Nothing
Set olkLst = Nothing
Set olkApt = Nothing
MsgBox "Purge complete.", vbInformation + vbOKOnly, "Purge Canceled Appointments"