Cancellazione Calendario Outlook

 

Le riunioni di lavoro spesso vengono indette utilizzando Outlook. Si creano così molti appuntamenti che rimangono nel "Calendario". Qui di seguito ho inserito il codice vbscript che NON cancella fisicamente gli appuntamenti ma li sposta nella cartella "Eliminata". Almeno sono tutti raggruppati li dentro e sarà possibile selezionarli e cancellarli fisicamente in un sol colpo.

 

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

a = ""
risp = ""


myData = InputBox("Inserisci la data PRIMA della quale vuoi che" & vbnewLine & _
      "siano cancellati gli elementi del calendario","Inserimento Data Limite", date)

if myData = "" then
 wscript.quit
end if

Set MyOL = CreateObject("Outlook.Application") 

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

'mi carico tutti gli elementi di calendar
Set MyListItemsCalendar = objFolder.Items
'eseguo ordinamento
MyListItemsCalendar.sort("[Start]")

'filtro tutti gli elementi che hanno data minore di quella indicata in myData
Set colFilteredItems = MyListItemsCalendar.Restrict("[Start] < '" & myData & "'")

if colFilteredItems.Count > 0 then

 risp = msgbox("Sto per cancellare " & colFilteredItems.Count & " elementi dal calendario " & vbNewLine & _
      "con data precedente a " & myData & "!!!" & vbNewLine & vbNewLine & _
      "Sei proprio sicuro di volerli cancellare?" & vbNewLine , vbOkCancel + vbSystemModal + vbExclamation, "Conferma Cancellazione Elementi Calendario")

 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 "Cancellati i seguenti appuntamenti dal calendario: " & vbNewLine & a, vbInformation + vbSystemModal, "Risultato della Cancellazione"
 
 else
 
 msgbox "Nessun elemento trovato prima della data del " & myData, vbExclamation + vbSystemModal, "Assenza Elementi"
 
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: <<    <    >    >>