Job meeting are often organize using Outlook Calendar. So during the year there could be a lot of appointment in the "Calendar". Here it is a code to move the appointment into the "Delete" folder. So after you have only to select all and delete permanently from Outlook.

Dim risp, a, myData, MyOL, objNS, objFolder, MyListItemsCalendar, colFilteredItems

a = ""
risp = ""

myData = InputBox("Insert the date from which to delete Calendar elements","Insert of Date", date)

if myData = "" then
 wscript.quit
end if

Set MyOL = CreateObject("Outlook.Application") 

Set objNS = MyOL.GetNameSpace("MAPI")
Set objFolder = objNS.GetDefaultFolder(9)  'Calendar

'load all calendar elements
Set MyListItemsCalendar = objFolder.Items
'sort execution
MyListItemsCalendar.sort("[Start]")

'filter all elements that have date < myData (input one)
Set colFilteredItems = MyListItemsCalendar.Restrict("[Start] < '" & myData & "'")

if colFilteredItems.Count > 0 then

 risp = msgbox("I'm going to move to the delete folder " & colFilteredItems.Count & " calendar elemtents " & vbNewLine & _
      "with date < " & myData & "!!!" & vbNewLine & vbNewLine & _
      "Are you sure you want to delete them?" & vbNewLine , vbOkCancel + vbSystemModal + vbExclamation, "Confirm Calendar Elements Deletion")

 if risp <> vbOK then
  distruggi_oggetti
  wscript.quit
 end if

 for i = colFilteredItems.Count to 1 step - 1

  a = a & vbnewline & colFilteredItems.item(i).Subject & " - " & colFilteredItems.item(i).Start
  colFilteredItems.item(i).delete
  
 next

 msgbox "These calendar appointment have been moved into delete folder: " & vbNewLine & a, vbInformation + vbSystemModal, "Deletion Result"
 
 else
 
 msgbox "No element found before " & myData, vbExclamation + vbSystemModal, "No Elements"
 
end if

distruggi_oggetti

Sub distruggi_oggetti

 set ColFilteredItems = Nothing
 set MyListItemsCalendar = Nothing
 set objFolder = Nothing
 set objNS = Nothing
 set MyOL = Nothing

End Sub

_____________________________________________________________________

Pag: <<    <    >    >>