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.
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.
