StartDownloadsServiceSamplesWorkshopsContact DeutschEnglish
 
Samples
General
Outlook®
 
Awarded by
Microsoft since 2005:
mvp logo
VBOffice Info
Visitors1798525
Impressions6737191
Links
Imprint
Privacy Policy
Contact
E-Mail: Set expiry time
Author: Michael BauerHomepage
Date: 21.09.2007Accessed: 23521
  
Description

Daily we get a lot of e-mails that we want to keep just for a specific time and then delete them. So that you don't have to read the e-mail time and again for determining whether or not it can be deleted now, you can set an expiry time for the message. Outlook displays the message crossed out when it's due. Then you can see easily at a glance what messages can be deleted (even that could be automated).

This sample demonstrates how you can set the expiry time with only two clicks either for an opened or for all of the selected items in a folder. Additionally it demos how to easily support different languages.

The dialog asks you for a number of weeks with a default value of eight. If you click OK, the message will expire in eight weeks from today. If you enter a zero instead then the expiry time gets deleted. Entering a negative figure will display the message immediately as expired.

Public Sub SetExpiryTime()
  Dim Sel As Outlook.Selection
  Dim obj As Object
  Dim Interval As Long
  Dim ExpiryTime As Date
  Dim Text$

  If TypeOf Application.ActiveWindow Is Outlook.Inspector Then
    Set obj = Application.ActiveInspector.CurrentItem

  Else
    Set Sel = Application.ActiveExplorer.Selection
    If Sel.Count = 0 Then
      Exit Sub
    Else
      Set obj = Sel(1)
    End If
  End If

  Select Case True
  Case (TypeOf obj Is Outlook.MailItem), _
    (TypeOf obj Is Outlook.MeetingItem), _
    (TypeOf obj Is Outlook.PostItem)

    ExpiryTime = obj.ExpiryTime
  End Select

  If ExpiryTime = #1/1/4501# Then
    Text = "-"
  Else
    Text = ExpiryTime
  End If

  If Application.LanguageSettings.LanguageID(2) = 1031 Then
    Text = "Aktuelles Ablaufdatum: " & Text & vbCrLf & vbCrLf
    Text = Text & "In wieviel Wochen soll die Auswahl ablaufen?"
    Text = InputBox(Text, , "8")
  Else
    Text = "Current expiry time: " & Text & vbCrLf & vbCrLf
    Text = Text & "In how many weeks should the selection expire?"
    Text = InputBox(Text, , "8")
  End If

  If Len(Text) Then
    Interval = Val(Text)

    If Interval Then
      ExpiryTime = DateAdd("ww", Interval, Date)
    Else
      ExpiryTime = #1/1/4501#
    End If

    If Not Sel Is Nothing Then
      For Each obj In Sel

        Select Case True
        Case (TypeOf obj Is Outlook.MailItem), _
          (TypeOf obj Is Outlook.MeetingItem), _
          (TypeOf obj Is Outlook.PostItem)

          obj.ExpiryTime = ExpiryTime
          obj.Save
        End Select
      Next

    Else
      Select Case True
      Case (TypeOf obj Is Outlook.MailItem), _
        (TypeOf obj Is Outlook.MeetingItem), _
        (TypeOf obj Is Outlook.PostItem)

        obj.ExpiryTime = ExpiryTime
        obj.Save
      End Select
    End If
  End If
End Sub
 
 

ReplyAll alerts you before unintentionally replying all, or if you are a confidential BCC recipient of the ... [more]

 

Access the master category list in the blink of an eye, share your categories in a network, get a reminder service, and ... [more]

 

SAM automatically sets the sender, signature, and folder for sent items, for instance based on the recipient ... [more]

 

OLKeeper reliably prevents users from closing their Outlook window and thus possibly missing reminders or ... [more]