?
Solved

Outlook Programing - Inbox Cleanup on Quit Event

Posted on 2008-10-13
3
Medium Priority
?
386 Views
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!  
0
Comment
Question by:BITASCII
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 3
3 Comments
 
LVL 59

Accepted Solution

by:
Chris Bottomley earned 2000 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.

Chris
Private Sub Application_Quit()
    OLQuit
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
    Next
'    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
        Else
        End If
    Next
    Set nav2Folder = reqdFolder
    Set olApp = Nothing
    Set olNS = Nothing
    Set olfldr = Nothing
    Set reqdFolder = Nothing
End Function

Open in new window

0
 
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

Chris
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 22718317
Glad to have helped ... andthanks for the grade.

Chris
0

Featured Post

Get free NFR key for Veeam Availability Suite 9.5

Veeam is happy to provide a free NFR license (1 year, 2 sockets) to all certified IT Pros. The license allows for the non-production use of Veeam Availability Suite v9.5 in your home lab, without any feature limitations. It works for both VMware and Hyper-V environments

Question has a verified solution.

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

A list of top three free exchange EDB viewers that helps the user to extract a mailbox from an unmounted .edb file and get a clear preview of all emails & other items with just a single click on mailboxes.
This article will help to fix the below errors for MS Exchange Server 2013 I. Certificate error "name on the security certificate is invalid or does not match the name of the site" II. Out of Office not working III. Make Internal URLs and Externa…
In this video we show how to create a mailbox database 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 Servers >> Data…
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…
Suggested Courses
Course of the Month15 days, 3 hours left to enroll

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