Mark items as read when deleted/moved to trash

Question

In Outlook 2010, using the code below, anything I delete or move into the trash folder is automatically marked as read.

Option Explicit
Dim WithEvents DeletedItems As Outlook.Items
    
Private Sub Application_Startup()
    Set DeletedItems = Session.GetDefaultFolder(olFolderDeletedItems).Items
End Sub
    
Private Sub DeletedItems_ItemAdd(ByVal Item As Object)
    If Item.UnRead = True Then
        Item.UnRead = False
        Item.Save
    End If
End Sub

It does not work at all in Outlook 2013.

Here is the code I am using to check how Outlook is seeing the read/unread status of the deleted emails. I lifted the Pause function from here.

Private Sub DeletedItems_ItemAdd(ByVal Item As Object)
    RememberItem Item 'Remember which email this is
    Debug.Print "At start: " & Item.UnRead 'Should be True
    If Item.UnRead = True Then
        Item.UnRead = False
        Item.Save
    End If
    Debug.Print "After mark read: " & Item.UnRead 'Should be False
    Pause 10 'In separate module. Code from https://stackoverflow.com/a/30196332/2623367
    Debug.Print "After pause: " & Item.UnRead 'Should be False unless item has become Unread
End Sub
    
Private Function RememberItem(Optional ByVal Item As Object) As Object
    'Allows check-up on the deleted item after event-handler is done with it.
    Static oDeleted As Object
    If Not Item Is Nothing Then Set oDeleted = Item
    Set RememberItem = oDeleted
End Function
    
Private Sub CheckStatus()
    Dim CheckItem As Object
    Set CheckItem = RememberItem
    Debug.Print "Follow-up check: " & CheckItem.UnRead 'Should be False
End Sub

The output I get:

• At start: True (item is unread - this is correct)
• After mark read: False (item is read - this may or may not be correct)
• After pause: False (item is read - this is incorrect)
• Follow-up check: False (item is read - this is incorrect)

---

UPDATE:

The answer marked as working did resolve my issue, though I occasionally still saw some odd behaviors.

A little more digging around revealed that the root cause was a sync issue between Outlook and the email server. Outlook would delete things, but the syncing would go screwy, and it looks like Outlook was pulling updates from the server before sending its own updates back. The discrepancies seem to have caused Outlook to lose track of what state deleted emails should be in.

My workplace uses Google Apps as their email provider, and I had set everything up in Outlook with the correct IMAP settings, but Google and Outlook don't play nice. Was able to eliminate all unpredictable behavior by using the selected answer and Google's Outlook syncing tool for Google Apps.

Also confirmed my original code behaves as it should when used in conjunction with the Google Apps sync tool.

I should have realized a lot sooner that the issue could be Google and Outlook being buggy together, but it didn't even occur to me, which is why I failed to mention the Google component of this equation earlier.

Answer 1

I haven't been able to figure out the exact issue you are having, as I can't replicate it, but try this:

Option Explicit

Dim WithEvents MainFolder As Outlook.Folder

 Private Sub Application_Startup()
     Set MainFolder = Session.GetDefaultFolder(olFolderInbox)
 End Sub


 Private Sub MainFolder_BeforeItemMove(ByVal Item As Object, ByVal MoveTo As MAPIFolder, Cancel As Boolean)

     If MoveTo.Name = Session.GetDefaultFolder(olFolderDeletedItems).Name And Item.UnRead = True Then
         Item.UnRead = False
         Item.Save
     End If
 End Sub