Outlook Programing - Inbox Cleanup on Quit Event

Posted on 2008-10-13
Last Modified: 2012-06-21
Does anyone know of VB code that can automagically move Inbox items older than 14 days into a user-defined folder, for example Inbox2, on Outlook client 2003's Application_Quit() event?  We have Inbox retention policies on our Exch 2003 Servers, but they don't fit our needs and Admins really don't have time to customize - hence our need for local VB code.  Thanks!  
Question by:BITASCII
  • 3
LVL 59

Accepted Solution

Chris Bottomley earned 500 total points
Comment Utility
Not a rule as such since rules are driven by send/receive events howevedr in VBA a routine can be coded off the quit application using the following code:

An application code routine, (Application_Quit) for Quit and two supporting code routines, (OLQuit & nav2folder) for the work of moving.  The folder path to where you want the mails moving needs to be correctly defined in OLQuit on the line:
Set fldr = nav2Folder("\\Personal Folders\Inbox\Inbox2")
In this case I established the folder as a subfolder of the inbox but anything goes just about.

Private Sub Application_Quit()


End Sub

Sub OLQuit()

Dim fldr As Outlook.MAPIFolder

Dim objitem As Object

Dim mai As mailitem

Dim strFilter As String

Dim olMailItems As Outlook.Items


    On Error Resume Next

    Set fldr = nav2Folder("\\Personal Folders\Inbox\Inbox2")

    strFilter = "[ReceivedTime] <= '" & Format(DateAdd("d", -14, Date) + TimeSerial(0, 0, 0), "ddddd h:nn AMPM") & "'"

    Set olMailItems = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Items.Restrict(strFilter)


    ' process all the items in this folder

    For Each objitem In olMailItems

        If TypeName(objitem) = "MailItem" Then

            Set mai = objitem

            mai.Move fldr

        ElseIf TypeName(objitem = "ReportItem") Then

        End If


'    Debug.Print Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Items.count & vbTab & olMailItems.count

End Sub

Public Function nav2Folder(foldername As String) As Outlook.MAPIFolder

Dim olApp As Outlook.Application

Dim olNS As Outlook.NameSpace

Dim olfldr As Outlook.folders

Dim reqdFolder As Outlook.MAPIFolder

Dim arrFolders() As String

Dim nestCount As Integer


    On Error Resume Next

    foldername = Replace(Replace(foldername, "/", "\"), "\\", "")

    If Right(foldername, 1) = "\" Then foldername = Left(foldername, Len(foldername) - 1)

    arrFolders() = Split(foldername, "\")

    Set olApp = Outlook.Application

    Set olNS = olApp.GetNamespace("MAPI")

    Set reqdFolder = olNS.folders.item(arrFolders(0))

    For nestCount = 1 To UBound(arrFolders)

        If Not reqdFolder Is Nothing Then

            Set olfldr = reqdFolder.folders

            Set reqdFolder = olfldr.item(arrFolders(nestCount))

            If reqdFolder <> olfldr.item(arrFolders(nestCount)) Then

                reqdFolder.folders.Add (arrFolders(nestCount))

                Set olfldr = reqdFolder.folders

                Set reqdFolder = olfldr.item(arrFolders(nestCount))

            End If


        End If


    Set nav2Folder = reqdFolder

    Set olApp = Nothing

    Set olNS = Nothing

    Set olfldr = Nothing

    Set reqdFolder = Nothing

End Function

Open in new window

LVL 59

Expert Comment

by:Chris Bottomley
Comment Utility
To Create a macro:

Alt + F11 to open the macro editor
  For workbook event handlers:
     In the project tree select as appropriate:
      OUTLOOK      : thisOutlookSession
     In the workpane select as appropriate:
      OUTLOOK      : General
     In the workpane select the required 'event', (i.e. 'open').
     Insert the required macro(s) into the selected subroutine.
  For User Code:
     Insert | Module to insert a code module into the project
     In the project tree select the module.
     Insert the required macro(s) into the selected module, ('Module1' or similar)
Close the Visual Basic Editor.

Check Security as appropriate:

In the application select Tools | Macro | Security
Select Medium
Select OK

LVL 59

Expert Comment

by:Chris Bottomley
Comment Utility
Glad to have helped ... andthanks for the grade.


Featured Post

Do email signature updates give you a headache?

Constantly trying to correctly format email signatures? Spending all of your time at every user’s desk to make updates? Want high-quality HTML signatures on all devices, including on mobiles and Macs? Then, let Exclaimer solve all your email signature problems today!

Join & Write a Comment

Following basic email etiquette rules will help you write a professional email and achieve a good, lasting impression with your contacts.
Scam emails are a huge burden for many businesses. Spotting one is not always easy. Follow our tips to identify if an email you receive is a scam.
In this video we show how to create an Accepted Domain in Exchange 2013. We show this process by using the Exchange Admin Center. Log into Exchange Admin Center.: First we need to log into the Exchange Admin Center. Navigate to the Mail Flow >> Ac…
The basic steps you have just learned will be implemented in this video. The basic steps are shown to configure an Exchange DAG in a live working Exchange Server Environment and manage the same (Exchange Server 2010 Software is used in a Windows Ser…

771 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now