Automatically Delete Messages

[ngardner]

Hi all,
Our office has daily legal news that is sent to all inboxes. No matter how much we remind people, some still do not delete them and so the inboxes keep getting bigger and bigger!!
Does anyone know if there is a way to ensure that these messages are deleted after 7/14 days, unless the user flags the message to keep?
We are running Outlook 2000.

 

[ttmac]

ngardner

Set the expiry date on the News items you issue so that the items will expire after a given period.

Include the following code in the THISOUTLOOKSESSION code panel

Private Sub Application_Startup()
    Call Delete_Expired_Messages
End Sub

Include the following code in a standard Outlook code module:-

Sub Delete_Expired_Messages()
    Dim OLF As Outlook.MAPIFolder, CurrUser As String
    Dim EmailItemCount As Integer, i As Integer, EmailCount As Integer
    Set OLF = GetObject("", "Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
EmailItemCount = OLF.Items.Count
    i = 0: EmailCount = 0
    ' read e-mail information
       
    While i < EmailItemCount
        i = i + 1
        If (OLF.Items(i).ExpiryTime < (Now() - 7)) Then
            OLF.Items(i).Delete
            EmailItemCount = EmailItemCount - 1
        End If
    Wend
    Set OLF = Nothing
End Sub

The above code will, on startup, delete messages in the users inbox whose expiry date was 7 days ago. This means that if a message has an expiry date of say 14 days after date of issue, the message will be available for up to 21 days in the users inbox.

The user can either move the message from their inbox or uncheck the expires on option in the Options panel.

Hope this helps.

Tom.