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 SubTips:
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.
沒有留言:
發佈留言