Usuwanie danych z kosza (z warunkiem)

by vbatools on Aug.18, 2010, under Outlook, Porady

Niejednokrotnie użytkownicy trzymają w koszu (folder “Elementy usunięte”) usunięte wcześniej obiekty, traktując je jako repozytorium spraw załatwionych. Pomijając słuszność takiej decyzji poniższa procedura posiada warunek usunięcia skasowanych obiektów będących wiadomościami o nazwie adresata “PROMOCJA”.

Dla kasowania wszystkich elementów wstawione warunki można usunąć.

Sub USUN_z_kosza()
'MVP OShon from VBATools.pl
Dim x&, oApptFolder As MAPIFolder
Dim IoTask As Items
Dim objItem As Object

 Set oApptFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderDeletedItems)
 Set IoTask = oApptFolder.Items
 For x = IoTask.Count To 1 Step -1
 DoEvents
 If IoTask.item(x).Class = 43 Then 'warunek tylko na wiadomości email
 Set objItem = IoTask.item(x)
 On Error GoTo blad
 If UCase(objItem.SenderName) = "PROMOCJA" Then objItem.Delete 'można użyć operatora Like
  'objItem.Delete 'jeśli chcemy usunąć wszystkie wiadomości bez warunku
 End If
 Next
zakoncz:
Set oApptFolder = Nothing
Set IoTask = Nothing
Set objItem = Nothing
Exit Sub
blad:
MsgBox "Błąd w obiekcie posiadającym temat " & objItem.Subject & vbCr & _
 "Procedura została przerwana", vbExclamation, "VBATools.pl"
Resume zakoncz
End Sub

Aby osadzić procedurę “USUN_z_kosza” pod przyciskiem w menu MS Outlook, polecam uwadze ten artykuł.