Delete email from inbox and also delete it from deleted-items folder via rule->script

Question

I created a rule, that starts a VBA-script depending on the subject of a received email (Rule: Subject "MY_SUBJECT" -> start script).
The VBA script is then doing some stuff and then it should finally delete the original email.

This part is easy:

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

' delete email from inbox
Item.Delete
End Sub

Now the email will sit in the deleted-items-folder. But what I need to achieve is, to also delete this mail from the deleted-items folder. Since I know the subject of this mail (because this triggered my rule in the first place), I tried the following approach:

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

Well, this basically works: The mail with this subject will be found in the deleted-items-folder and it will be deleted, yes. But sadly it does not work as expected: This permanent deletion only works once I start the script a second time.

So the email which is triggering my script will never be deleted permanently in this script's actual run, but only in the next run (once the next email with the trigger-subject for my rule is received - but then this very next email won't be deleted, again).

Do you have any idea what I am doing wrong here? It somehow looks like I need to refresh my deleted-items folder somehow. Or do I have to comit my first Item.Delete somehow explicitly?

Answer 1

The problem was not recreated, but try stepping through this then run normally if it appears to do what you want.

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

Answer 2

Tim Williams suggested another existing thread. I had a look at that already before and decided that appoach would be exactly the same representation of my bug. I did try it out, though (to show my motiviation :) ), but the behaviour is - as expected - exactly the same: Again the final deletion only works once the next time the script is triggered via rule:

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

I would be really glad to get some help here. I also wanted to comment on that other thread, but my reputation is not enough, yet.

Answer 3

Try something like this, code goes under 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

Edit

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 4

the Mailbox folder that you get can be used as a collection, meaning that you can remove the item directly, you will need the collection to be sent to the function but that should be managable :)

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

' delete email from inbox
For Ite = 1 To Mailbox.Items.Count
    If Mailbox.Items(Ite).EntryID = Item.EntryID Then
        Mailbox.Items.Remove Ite
        Exit For
    End If
Next
End Sub

Remember that IF you want to Delete more than 1 Item per call of "For Ite = 1 To Mailbox.Items.Count", you will need to subtract 1 from the check of the item within the For segment since when you remove a mail from it, it will reduce the rest of the mails index number by 1.

Hope you can still use this :)

Regards Sir Rolin