Drastically shorten your training time with WalkMe's advanced online training solution that Guides your trainees to action. Forget about retraining and skyrocket knowledge retention rates.
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
Add your voice to the tech community where 5M+ people just like you are talking about what matters.
|Accidentally deleted Outlook data files. I restored from recycly bin, but Outlook can't find the files now.||12||129|
|Deny sending to more than 2 recipients in Exchange 2016||2||46|
|email adress opens in chrome||13||62|
|User has constant problems with Outlook and Quickbooks||8||35|
Join the community of 500,000 technology professionals and ask your questions.