email Supprimer la boîte de réception et de supprimer également de deleted-éléments par dossier rule-> Script

Question

J'ai créé une règle, qui démarre un script VBA en fonction de l'objet d'un courrier électronique reçu (Règle: Sujet « MY_SUBJECT » -> Démarrer le script).
Le script VBA est alors en train de faire des choses et il devrait enfin supprimer l'email d'origine.

Cette partie est facile:

Sub doWorkAndDeleteMail(Item As Outlook.MailItem) 
' doSomething: 

' delete email from inbox 
Item.Delete 
End Sub 

Maintenant, l'e-mail sera assis dans le dossier des éléments-supprimés. Mais ce que je dois réaliser, c'est aussi de supprimer ce courrier du dossier des éléments supprimés. Depuis que je connais le sujet de ce courrier (parce que ce qui a déclenché ma règle en premier lieu), j'ai essayé l'approche suivante:

Sub doWorkAndDeleteMail(Item As Outlook.MailItem) 
' doSomething: 

' delete email from inbox 
Item.Delete 
End Sub 

' delete email from deleted items-folder 
Dim deletedFolder As Outlook.Folder 

Set deletedFolder = Application.GetNamespace("MAPI"). _ 
    GetDefaultFolder(olFolderDeletedItems) 

Dim i As Long 
For i = myFolder.Items.Count To 1 Step -1 

If (deletedFolder.Items(i).Subject) = "MY_SUBJECT" Then 

deletedFolder.Items(i).Delete 
Exit For 
End If 
Next if 

End Sub 

Eh bien, cela fonctionne essentiellement: On trouvera le mail avec ce sujet dans le supprimé-items-dossier et il sera supprimé, oui. Mais malheureusement, cela ne fonctionne pas comme prévu: Cette suppression permanente ne fonctionne que lorsque je recommence le script une seconde fois. Donc l'email qui déclenche mon script ne sera jamais effacé définitivement dans l'exécution actuelle de ce script, mais seulement lors de la prochaine exécution (une fois que le prochain email avec le sujet déclencheur de ma règle sera reçu) email ne sera pas supprimé, encore une fois).

Avez-vous une idée de ce que je fais mal ici? Il semble que j'ai besoin de rafraîchir mon dossier d'éléments supprimés d'une manière ou d'une autre. Ou dois-je passer mon premier Item.Delete en quelque sorte explicitement?

Answer 1

Tim Williams a suggéré un autre thread existant. J'y ai déjà jeté un coup d'œil et j'ai décidé que l'appoach serait exactement la même représentation de mon bug. Je l'ai essayé (pour montrer ma motivation :)), mais le comportement est - comme prévu - exactement le même: Encore une fois, la suppression finale ne fonctionne que la prochaine fois que le script est déclenché par la règle:

Sub doWorkAndDeleteMail(Item As Outlook.MailItem) 
' First set a property to find it again later 
Item.UserProperties.Add "Deleted", olText 
Item.Save 
Item.Delete 

'Now go through the deleted folder, search for the property and delete item 
Dim objDeletedFolder As Outlook.Folder 
Dim objItem As Object 
Dim objProperty As Variant 

Set objDeletedFolder = Application.GetNamespace("MAPI"). _ 
    GetDefaultFolder(olFolderDeletedItems) 
For Each objItem In objDeletedFolder.Items 
    Set objProperty = objItem.UserProperties.Find("Deleted") 
    If TypeName(objProperty) <> "Nothing" Then 
     objItem.Delete 
    End If 
Next 

End Sub 

Je serais vraiment heureux de recevoir de l'aide ici. Je voulais aussi commenter cet autre sujet, mais ma réputation n'est pas encore suffisante.

Answer 2

Essayez quelque chose comme ça, le code passe sous ThisOutlookSession

Private WithEvents Items As Outlook.Items 
Private Sub Application_Startup() 
    Dim olNs As Outlook.NameSpace 
    Dim DeletedFolder As Outlook.MAPIFolder 

    Set olNs = Application.GetNamespace("MAPI") 
    Set DeletedFolder = olNs.GetDefaultFolder(olFolderDeletedItems) 
    Set Items = DeletedFolder.Items 
End Sub 

Private Sub Items_ItemAdd(ByVal Item As Object) 
    Dim olNs As Outlook.NameSpace 
    Dim DeletedFolder As Outlook.MAPIFolder 
    Dim Items As Outlook.Items 
    Dim Filter As String 
    Dim i As Long 

    Set olNs = Application.GetNamespace("MAPI") 
    Set DeletedFolder = olNs.GetDefaultFolder(olFolderDeletedItems) 

    Filter = "[Subject] = 'MY_SUBJECT'" 

    Set Items = DeletedFolder.Items.Restrict(Filter) 

    If TypeOf Item Is Outlook.MailItem Then 

     For i = Items.Count To 1 Step -1 
      DoEvents 
      Items.Remove i 
     Next 

    End If 
End Sub 

Modifier

Sub doWorkAndDeleteMail(Item As Outlook.MailItem) 
    ' First set a property to find it again later 
    Item.UserProperties.Add "Deleted", olText 
    Item.Save 
    Item.Delete 

    'Now go through the deleted folder, search for the property and delete item 
    Dim olNs As Outlook.NameSpace 
    Dim DeletedFolder As Outlook.MAPIFolder 
    Dim Items As Outlook.Items 
    Dim Filter As String 
    Dim i As Long 

    Set olNs = Application.GetNamespace("MAPI") 
    Set DeletedFolder = olNs.GetDefaultFolder(olFolderDeletedItems) 

    Filter = "[Subject] = 'MY_SUBJECT'" 

    Set Items = DeletedFolder.Items.Restrict(Filter) 

    If TypeOf Item Is Outlook.MailItem Then 

     For i = Items.Count To 1 Step -1 
      DoEvents 
      Items.Remove i 
     Next 

    End If 
End Sub 

Answer 3

Le problème n'a pas été recréée, mais essayez de marcher à travers cette exécution alors normalement si elle semble fais ce que tu veux.

Sub doWorkAndDeleteMail(Item As mailitem) 

Dim currFolder As Folder 
Dim DeletedFolder As Folder 

Dim i As Long 
Dim mySubject As String 

Set currFolder = ActiveExplorer.CurrentFolder 
mySubject = Item.Subject 
Debug.Print mySubject 

Set DeletedFolder = GetNamespace("MAPI").GetDefaultFolder(olFolderDeletedItems) 

Set ActiveExplorer.CurrentFolder = DeletedFolder 

Debug.Print "DeletedFolder.count before delete: " & DeletedFolder.Items.count 
' delete email from deleted items-folder 
Item.Delete 
Debug.Print "DeletedFolder.count after delete: " & DeletedFolder.Items.count 

' If necessary 
'DoEvents 

For i = DeletedFolder.Items.count To 1 Step -1 

    Debug.Print DeletedFolder.Items(i).Subject 

    If (DeletedFolder.Items(i).Subject) = mySubject Then 

     Debug.Print DeletedFolder.Items(i).Subject & " *** found ***" 

     DeletedFolder.Items(i).Delete 

     Exit For 

    End If 
Next 

Set ActiveExplorer.CurrentFolder = currFolder 

End Sub