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
ID: 22708934
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
ID: 22708942
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
ID: 22718317
Glad to have helped ... andthanks for the grade.


Featured Post

Is Your AD Toolbox Looking More Like a Toybox?

Managing Active Directory can get complicated.  Often, the native tools for managing AD are just not up to the task.  The largest Active Directory installations in the world have relied on one tool to manage their day-to-day administration tasks: Hyena. Start your trial today.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

What does UTC stand for?  “Coordinated Universal Time” – Think of this as the true time on Planet Earth that never changes with the exception of minor leap seconds here and there to account for the changes in the planet's rotation.   What does th…
Utilizing an array to gracefully append to a list of EmailAddresses
In this video we show how to create an email address policy 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…
CodeTwo Sync for iCloud ( automatically synchronizes your Outlook 2016, 2013, 2010 or 2007 folders with iCloud folders available via iCloud Control Panel. This lets you automatically sync them with…

911 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

20 Experts available now in Live!

Get 1:1 Help Now