मुझे आपके द्वारा पूछे गए सटीक प्रश्न की खोज का उत्तर मिला ।
आपको निम्नलिखित स्रोत कोड के साथ एक मैक्रो बनाना होगा (मेलबॉक्स का नाम अपने स्वयं के लिए बदलें):
Set olResCalendar = OpenMAPIFolder("\MailboxName\Calendar")
Sub RemoveCanceledAppointments()
Dim olResCalendar As Outlook.MAPIFolder, olApptItem As Outlook.AppointmentItem, intCounter As Integer
'Change the path to the resource calendar on the next line
Set olResCalendar = OpenMAPIFolder("\MailboxName\Calendar")
For intCounter = olResCalendar.Items.Count To 1 Step -1
Set olApptItem = olResCalendar.Items(intCounter)
If Left(olApptItem.Subject, 9) = "Canceled:" Then
olApptItem.Delete
End If
Next
Set olApptItem = Nothing
Set olResCalendar = Nothing
End Sub
Function OpenMAPIFolder(szPath)
Dim app, ns, flr, szDir, i
Set flr = Nothing
Set app = CreateObject("Outlook.Application")
If Left(szPath, Len("\")) = "\" Then
szPath = Mid(szPath, Len("\") + 1)
Else
Set flr = app.ActiveExplorer.CurrentFolder
End If
While szPath <> ""
i = InStr(szPath, "\")
If i Then
szDir = Left(szPath, i - 1)
szPath = Mid(szPath, i + Len("\"))
Else
szDir = szPath
szPath = ""
End If
If IsNothing(flr) Then
Set ns = app.GetNamespace("MAPI")
Set flr = ns.Folders(szDir)
Else
Set flr = flr.Folders(szDir)
End If
Wend
Set OpenMAPIFolder = flr
End Function
Function IsNothing(Obj)
If TypeName(Obj) = "Nothing" Then
IsNothing = True
Else
IsNothing = False
End If
End Function
पृष्ठ से उद्धरण:
यह मैक्रो एक संसाधन कैलेंडर के माध्यम से खोज करेगा और विषय में "रद्द:" के साथ आइटम हटा देगा। इसके लिए आपके पास संसाधन मेलबॉक्स पर उचित अनुमतियाँ भी होनी चाहिए। यह मैक्रो रद्द मीटिंगों को हटा देगा, दोनों सीधे बुकिंग और ऑटोसेप्टेड मीटिंग्स को हटा देगा।