Kleine Helfer für Outlook

Seit vielen jahren arbeite ich (dienstlich) mit Outlook. Generell gefällt mir dieses Programm für die Mailbearbeitung und auch für die Aufgabenverwaltung sehr gut. Allerdings gibt es – wie bei fast jeder Software – ein paar Verbesserungsmöglichkeiten. Zum Glück bietet Outlook die Möglichkeit, mit etwas VBA Code nachzuhelfen.

An dieser Stelle möchte ich einige von mir selbst entwickelte Helferlein vorstellen:

1. Kürzel im Betreff löschen:

Im Outlook bekommen beantwortete bzw. weitergeleitete Mails automatisch ein Kürzel verpasst (z.B. AW:, RE:, WG:, …)

Diese Kürzel werden fortgeführt, wenn diese Mails nochmals beantwortet oder weitergeleitet werden. Mit der Zeit können dann die Mails im Posteingang recht unleserlich werden.

Um dieses Problem zu beheben habe ich ein kleines VBA-Script geschrieben, dass die Kürzel aus den Mail-Betreffs einfach rauslöscht. Hier das Script:

Sub kuerzel_loeschen()
    On Error Resume Next

    Dim Element
    Dim objMail As MailItem
    Dim lh_string

    For Each Element In ActiveExplorer.Selection

        Set objMail = Element
        lh_string = objMail.Subject

        lh_string = Replace(lh_string, "WG: ", "")
        lh_string = Replace(lh_string, "Wg: ", "")
        lh_string = Replace(lh_string, "RE: ", "")
        lh_string = Replace(lh_string, "Re: ", "")
        lh_string = Replace(lh_string, "AW: ", "")
        lh_string = Replace(lh_string, "Aw: ", "")
        lh_string = Replace(lh_string, "FW: ", "")
        lh_string = Replace(lh_string, "EM: ", "")
        lh_string = Replace(lh_string, "Odp.: ", "")
        lh_string = Replace(lh_string, "VS: ", "")
        lh_string = Replace(lh_string, "VB: ", "")
        lh_string = Replace(lh_string, "Fw: ", "")
        lh_string = Replace(lh_string, "Fwd: ", "")
        lh_string = Replace(lh_string, "Antwort: ", "")
        lh_string = Replace(lh_string, "SV: ", "")
        lh_string = Replace(lh_string, "[Possible Spam] ", "")
        lh_string = Replace(lh_string, "E-Mail schreiben an: ", "")
        ' Diese Liste kann nach Bedarf beliebig fortgeführt werden...

        objMail.Subject = lh_string
        objMail.Save
   Next

End Sub

Mit diesem Script werden für alle markierten Mails die unerwünschten Kürzel gelöscht.

2. Anlagen Lokal Speichern

Ein weiteres Problem bei meiner Arbeit mit Outlook besteht darin, dass mein Arbeitgeber die Größe meines Postfaches auf 400MB beschränkt. Nun kommt es aber in der täglichen Projektarbeit regelmäßig vor, dass man Mails mit großen Anlagen bekommt, durch die sich die genutzte Postfachgröße schnell ausdehnt.

Durch ein kleines VBA-Script speichere ich alle Anhänge, die eine bestimmte größe überschreiten lokal auf meiner Festplatte ab und füge in die Mail automatisch einen Link zu der lokal gespeicherten Datei.

Damit bekomme ich meine Postfachgröße schnell wieder kleiner.

Hier das Script:

Const c_folder As String = "D:\Outlook_Archive\Anlagen"
'Dies ist der Pfad, in dem die Anhänge abgespeichert werden

Const c_minsize As Long = 300000
'minimale Dateigröße in Byte, Anlagen, die kleiner sind, bleiben
'in der Mail

Public Sub Anlagen_Lokal_Speichern()
    Dim Ordnername As String
    Dim objPosteingang As MAPIFolder
    Dim objNewMail As MailItem
    Dim Element
    Dim objMail As MailItem
    Dim date_time As String

    On Error Resume Next

    Set objPosteingang = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)

    For Each Element In ActiveExplorer.Selection
        Set objMail = Element

        With objMail

                anzahl = .Attachments.Count
                If anzahl > 0 Then

                    Ordnername = c_folder
                    MkDir Ordnername 'erstellt den Ordner, falls nicht vorhanden

                    For i = 1 To anzahl
                        If .Attachments.Item(i).Size >= c_minsize Then
                        ' nur speichern, wenn die Datei groß genug ist!
                        ' dadurch verhindern, dass keine kleinen Bider gespeichert werden.

                        date_time = Format(.CreationTime, "YYMMDDHHMM")

                        .Attachments.Item(i).SaveAsFile Ordnername & "\" & date_time & "_" & .Attachments.Item(i).FileName
                        ' Zeitstempel mit in die Anlage nehmen, damit sie auch gespeichert, wird, wenn es schonmal eine Datei
                        ' mit demselben Namen gibt

                        .Body = "Anlage gespeichert unter: <file://" & _
                                Ordnername & "\" & date_time & "_" & .Attachments.Item(i).FileName & "> " & _
                                Chr(13) & Chr(10) & _
                                Chr(13) & Chr(10) & _
                                .Body

                        .Attachments.Item(i).Delete
                        .Save

                        End If
                    Next i
                End If

        End With
    Next Element
End Sub

Mit diesem Script werden für alle markierten Mails die Anlagen lokal abgespeichert.

PS: Mir ist bewusst dass man die Mails auch archivieren könnte.