2015年10月26日星期一

Outlook+VBA: How to delete older deleted email after n days automatically on schedule?

Here's coding is only for selecting a specific folder such as "Deleted Items" and check the date whether is older than n days, for example is 14 days, then delete it permanently.

Reference, if you don't know : How to create VBA function, Outlook rule and enable macros in Outlook?

1) Press Alt+F11 to open VBA to create a function on Outlook.

Example 1:
A simple way to delete all type of emails which are under “Deleted Items" folder and the Last Modifcation Time (DateTime) older than 14 days.
Sub CleanupDeletedEmail(Item As Outlook.MailItem)
    Dim DelItems As Outlook.Items
    Dim OlderDay As Integer
    
    OlderDay = 14

    Set DelItems = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderDeletedItems).Items
    
    For i = DelItems.Count To 1 Step -1
       If DateDiff("d", DelItems.Item(i).LastModificationTime, Date) >= OlderDay Then
            DelItems.Item(i).Delete
       End If
    Next

    Set DelItems = Nothing
End Sub
Tips:
1. You can also change the folder from Deleted Items “olFolderDeletedItems" to another such as Inbox “olFolderInbox".
2. As email that received will include non-email type, for example delivery email error that sent by outlook server or task, which does not have SentOn date, so using “LastModificationTime" instead of “SentOn".


Example 2:
Sending an email if there is any error found during deleting. Besides, if item type is email then check the SentOn date otherwise using LastModificationTime.
Sub CleanupDeletedEmail(Item As Outlook.MailItem)
    On Error GoTo ErrHandler
    
    Dim DelItems As Outlook.Items
    Dim OlderDay As Integer
    Dim IsDel As Boolean
    Dim sRptToEmailAddr As String
    
    OlderDay = 14
    sRptToEmailAddr = "name@domain.com"    

    Set DelItems = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderDeletedItems).Items
    
    For i = DelItems.Count To 1 Step -1
        IsDel = False    

        If DelItems.Item(i).Class = olMail Then
            If DateDiff("d", DelItems.Item(i).SentOn, Date) >= OlderDay Then
                IsDel = True
            End If
        ElseIf DateDiff("d", DelItems.Item(i).LastModificationTime, Date) >= OlderDay Then
            IsDel = True
        End If
        
        If IsDel = True Then DelItems.Item(i).Delete
    Next
    
GoTo Finally
ErrHandler:
    Call CreateNewMessage("Error: " + Item.Subject, sRptToEmailAddr, Err.Description)
Finally:
    Set DelItems = Nothing
End Sub

Sub CreateNewMessage(pSubject As String, pTo As String, pBody As String)
    Dim objMsg As MailItem    
    Set objMsg = CreateItem(olMailItem)
    With objMsg
        .Subject = pSubject
        .To = pTo
        .Body = pBody
        
        .Send
    End With

    Set objMsg = Nothing
End Sub

2) Save and exit VBA.

3) Create a new rule on Outlook.
3.1) Start from a blank rule: Select "Apply rule on messages I receive" -> press Next
3.2) Which condition(s) do you want to check? Select "with specific words in the subject"
3.3) Use mouse to click "specific words" in "Edit the rule description" box, and input "Call Cleanup Deleted Email". -> press "Add" -> press "OK".
3.4) What do you want to do with the message? Select "delete it" and "run a script".
3.5) Use mouse to click "run a script" in "Edit the rule description" box, and select "Project1.ThisOutlookSession.CleanupDeletedEmail". -> press Next.
3.6) Press Next to ignore "Are there any exceptions?".
3.7) Assign a name for this rule: Call Cleanup Deleted Email.
3.8) Press Finished.

rule

The action of this rule: When new email arrived which the subject is "Call Cleanup Deleted Email" then delete this email and run the script "CleanupDeleteEmail".

You can now to send an email with the subject is "Call Cleanup Deleted Email" to this account for checking whether the rule can call the script and delete the email which the date is older than 14 days correctly.

Using below tutorial link to create a Task Scheduler and send "Call Cleanup Deleted Email" email periodically.
Task Scheduler: Another way to send an email via SMTP using script

Below is an example to kick-off the task on 12:05am everyday. There are many options such as Daily, Weekly, Monthly or Repeating for you selection, so you can assign what you want in Trigger.
task

沒有留言:

發佈留言