Outlook Cleanup Script

Outlook is probably the most commonly used email platform. As an email client, it is loaded with features to simplify tasks and improve efficiency. However, there is a but… some “automated” tasks intended to make things easier don’t aways function as expected. One aspect of Outlook that people have expressed frustrations is with the Deleted Items folder and the automatic cleanup process.

When you move an item to the Deleted Items folder you probably see an informational message stating when the message will be removed from the system. Despite what the message may lead you to believe, it doesn’t always seem to function as expected. When it doesn’t function the amount of email waiting to be purged continues to grow, causing you to manually clean things up. There is a way however, to address this and give you more flexibility.

Within Outlook you can configure a script that will run on a recurring schedule. The script allows you to indicate the interval as well as set how many days deleted items should be retained before being permanently deleted. In order to configure scripts within Outlook, you first need to enable the Developer menu option. To do this, right mouse click in the Outlook menu bar and when the pop-up opens, select Customize the Ribbon… When selected, a new pop-up will open, and on the right side will be a list of available options to enable or disable. You will want to enable the Developer option by checking the box, then select Ok and when the pop-up closes, you should now see the Developer option in the Outlook menu bar.

With the Developer option now available, select it to display the new menu. Select the Visual Basic menu item to open the scripting interface. When it opens, on the right will be the Project panel, and you will want to right mouse click on the folder Microsoft Outlook Objects and select Insert, and then Module. On the right the new module window is displayed and you can copy/paste the below code. Below, the scanInt = 10 can be changed to any value you prefer. It determines how many minutes between scans for items to delete.

Private Sub Application_Quit()
  If TimerID <> 0 Then Call DeactivateTimer 'Turn off timer upon quitting **VERY IMPORTANT**
End Sub

Private Sub Application_Startup()

  ' If you don't want the pop-up on startup, comment it out by placing a ' in front of the MsgBox text.
  MsgBox "Activating the Timer." 
  Dim scanInt As LongLong
  scanInt = 10 ' **Note: Indicates how many minutes between scans.
  Call ActivateTimer(scanInt)
End Sub

Next you will right mouse click on the folder Modules and select Insert, and then Module. In the new module window on the right, copy/past the following code. The line near the bottom (If (fldr.Items(c).ReceivedTime < Now – 7) Then) indicates how many days deleted items should remain before being deleted. You can change this to any value you prefer.

Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongLong, ByVal nIDEvent As LongLong, ByVal uElapse As LongLong, ByVal lpTimerfunc As LongLong) As LongLong
Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongLong, ByVal nIDEvent As LongLong) As LongLong

Public TimerID As LongLong 'Need a timer ID to eventually turn off the timer. If the timer ID <> 0 then the timer is running

Public Sub TriggerTimer(ByVal hwnd As LongLong, ByVal uMsg As LongLong, ByVal idevent As LongLong, ByVal Systime As LongLong)
  'MsgBox "The TriggerTimer function has been automatically called!"

  Call DeleteEmail
End Sub


Public Sub DeactivateTimer()
Dim lSuccess As LongLong
  lSuccess = KillTimer(0, TimerID)
  If lSuccess = 0 Then
    MsgBox "The timer failed to deactivate."
  Else
    TimerID = 0
  End If
End Sub

Public Sub ActivateTimer(ByVal nMinutes As LongLong)
  nMinutes = nMinutes * 1000 * 60 'The SetTimer call accepts milliseconds, so convert to minutes
  If TimerID <> 0 Then Call DeactivateTimer 'Check to see if timer is running before call to SetTimer
  TimerID = SetTimer(0, 0, nMinutes, AddressOf TriggerTimer)
  If TimerID = 0 Then
    MsgBox "The timer failed to activate."
  End If
End Sub

Public Sub DeleteEmail()

Dim ol As Outlook.Application
Set ol = New Outlook.Application

Dim olNs As Outlook.NameSpace
Set olNs = ol.GetNamespace("MAPI")

Dim fldr As Outlook.MAPIFolder
Set fldr = olNs.GetDefaultFolder(olFolderDeletedItems) ' Target folder is Deleted Items.

Dim olMail As Outlook.MailItem


Dim c As LongLong
For c = fldr.Items.Count To 1 Step -1

    If (TypeOf fldr.Items(c) Is MailItem) Then
        ' **Note: Indicate the number of days items will remain in Deleted Items folder before deleting, 7 is the current value.
        If (fldr.Items(c).ReceivedTime < Now - 7) Then
            fldr.Items(c).Delete
        End If
    End If

Next c

End Sub

I personally use this script and have been happy with it. Email spam, malware, phishing, scams, etc., are constantly evolving and tying to get around system safe guards. Recently I’ve seen emails sent as calendar invites that are actually spam or contain links to install malicious code. You can change a setting in Outlook that will prevent them from automatically being added to your calendar.

Below are text files of the code above that you can download and use.

If you have questions, either leave a comment or send a message.