Question : I would like to automate this Outlook macro that deletes canceled meetings

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.
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
Sub CancApt()
    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
    Else
        GoTo EndMacro
    End If

    Set olkFld = Application.ActiveExplorer.CurrentFolder
    Set olkLst = olkFld.Items
    
    'To include recurring appointments, sort by using the Start property.
    olkLst.IncludeRecurrences = True
    olkLst.Sort "[Start]"
    
    'Restrict the Items collection.
    Set olkItemsInDateRange = olkLst.Restrict(strRestriction)

    'Loop to count the items'
    For Each olkApt In olkItemsInDateRange
        intCnt = intCnt + 1
    Next
    'Loop to process the items'
    For intIdx = intCnt To 1 Step -1
        Set olkApt = olkItemsInDateRange(intIdx)
        If Left(olkApt.Subject, 9) = "Canceled:" Then
            olkApt.Delete
        End If
    Next
    
EndMacro:
    Set olkFld = Nothing
    Set olkLst = Nothing
    Set olkApt = Nothing
    MsgBox "Purge complete.", vbInformation + vbOKOnly, "Purge Canceled Appointments"
End Sub

Answer : I would like to automate this Outlook macro that deletes canceled meetings

Touchdown offers a free trial and is considered by many to be a good Exchange app. Check it out?
Random Solutions  
 
programming4us programming4us