| | Awarded by
Microsoft since 2005: |  |
| | VBOffice Info | | Besucher | 1409608 | | Aufrufe | 5191049 |
| |
|
| |
| Autor: Michael Bauer | Homepage | | Datum: 21.09.2007 | Zugriffe: 18504 | | | | Beschreibung
Wir bekommen täglich viele E-Mails, die nur für eine bestimmte Zeit aufbewahrt werden sollen und dann gelöscht werden können. Damit Sie die E-Mails nicht immer wieder lesen müssen, um zu bestimmen, ob Sie nun gelöscht werden kann, gibt es in Outlook die Möglichkeit, jede Nachricht mit einem Ablaufdatum zu versehen. Wenn das Datum erreicht ist, stellt Outlook diese durchgestrichen dar. So sehen Sie auf einen Blick, was gelöscht werden kann (das kann sogar automatisiert werden).
Dieses Beispiel zeigt, wie Sie das Datum mit nur zwei Klicks entweder für eine geöffnete Nachricht oder für alle in einem Ordner selektierten Nachrichten festlegen können. Außerdem zeigt es, wie Sie ganz einfach mehrere Sprachen unterstützen können.
Über einen Dialog werden Sie gefragt, in wieviel Wochen (ab heute) die Nachricht ablaufen soll. Wenn Sie eine 0 eingeben, dann wird das Ablaufdatum gelöscht, bei negativen Zahlen wird die Nachricht sofort als abgelaufen dargestellt. |
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 warnt Sie, bevor Sie unbeabsichtigt allen Empfängern
einer E-Mail antworten oder wenn Sie ein vertraulicher BCC-Empfänger der E-Mail ... [weiter] |
| | |  | Blitzschneller Zugriff auf die Hauptkategorienliste, gemeinsame Kategorien im Netzwerk, eine Erinnerungsfunktion ... [weiter] |
| | |  | SAM legt automatisch Absender, Signatur und Speicherort für gesendete Mails fest, z.B. anhand der ... [weiter] |
| | |  | OLKeeper verhindert zuverlässig, dass Mitarbeiter Outlook schließen und dadurch Termine oder E-Mails ... [weiter] |
| | |
|
