VBA – Outlook: Namen der Dateien im E-Mail-Anhang am Anfang der E-Mail auflisten [Update 20.03.2015]

Beschreibung

Wer in Outlook E-Mails mit PGP verschlüsselt, nutzt häufig die verfügbare Funktion die E-Mail vollständig zu verschlüsseln. Das funktioniert gut, so lange Sender und Empfänger PGP verwenden. Verwendet der Empfänger allerdings GPG, taucht das Problem auf, dass die Namen der E-Mail-Anhänge nicht korrekt angezeigt werden. 

Die folgenden VBA-Makros (aktuell noch getrennt, eine Variante für E-Mails im „Nur Text“-Format und eine für E-Mails im „HTML“-Format) fügen am Anfang der aktiven E-Mail einen Textblock ein, der alle Dateinamen der Reihe nach auflistet und dem Empfänger so die Möglichkeit geben, zu erkennen, welche Dateien sich im Anhang befinden. Dem Sender erspart es zudem, manuell zu schreiben, welche Dateien / Dateitypen sich im E-Mail-Anhang befinden.

Damit die Funktion funktioniert, wird darüber hinaus die Funktion Namen der Dateien im E-Mail-Anhang auslesen benötigt.

Sourcecode für E-Mails im „Nur Text“-Format

Public Sub addAttFilenamesToMailAsText()
    ' Textkonstanten für die Begrenzungen
    Const ATTLIST_BORDER As String = "************************************************"
    Const ATTLIST_ENTRY_LINESTART As String = "* "

    ' aktuelles Outlookfenster als zu verwendendes definieren
    Dim curInspector As Outlook.Inspector
    Set curInspector = Application.ActiveInspector

    ' Prüfen, ob Dateianhänge vorhanden sind
    If Not TypeName(curInspector) = "Nothing" Then
        Dim sAtts() As String
        Dim iFoundAttCount As Integer
        Dim sBody As String

        ' Dateianhänge auslesen
        sAtts() = getAtts()

        iFoundAttCount = UBound(sAtts)

        ' Hinzuzufügenden Text zusammensetzen
        sBody = ATTLIST_BORDER + vbCrLf
        If iFoundAttCount > 0 Then
            Dim iAttNo As Integer

            For iAttNo = 0 To iFoundAttCount
                ' Jeden Anhang in einer neuen Zeile aufführen
                sBody = sBody + ATTLIST_ENTRY_LINESTART + sAtts(iAttNo) + vbCrLf
            Next iAttNo
        End If
        sBody = sBody + ATTLIST_BORDER + vbCrLf

        ' Mit aktuellem E-Mail-Objekt arbeiten
        Dim curItem As Outlook.MailItem
        Set curItem = curInspector.CurrentItem

        ' Text am Anfang der E-Mail einfügen
        curItem.Body = sBody + vbCrLf + vbCrLf + vbCrLf + curItem.Body
    End If
End Sub

Sourcecode für E-Mails im „HTML“-Format

    Public Sub addAttFilenamesToMailAsHTMLText()
        ' Textkonstanten für die Begrenzungen
        Const ATTLIST_BORDER As String = "************************************************"
        Const ATTLIST_ENTRY_LINESTART As String = "* "
     
        ' aktuelles Outlookfenster als zu verwendendes definieren
        Dim curInspector As Outlook.Inspector
        Set curInspector = Application.ActiveInspector
     
        ' Prüfen, ob Dateianhänge vorhanden sind
        If Not TypeName(curInspector) = "Nothing" Then
            Dim sAtts() As String
            Dim iFoundAttCount As Integer
            Dim sBody As String
     
            ' Dateianhänge auslesen
            sAtts() = getAtts()

            iFoundAttCount = UBound(sAtts)
     
            ' Hinzuzufügenden Text zusammensetzen
            sBody = ATTLIST_BORDER + "<br>"
            If iFoundAttCount > 0 Then
                Dim iAttNo As Integer
     
                For iAttNo = 0 To iFoundAttCount
                    ' Jeden Anhang in einer neuen Zeile aufführen
                    sBody = sBody + ATTLIST_ENTRY_LINESTART + sAtts(iAttNo) + "<br>"
                Next iAttNo
            End If
            sBody = sBody + ATTLIST_BORDER + "<br>"
     
            ' Mit aktuellem E-Mail-Objekt arbeiten
            Dim curItem As Outlook.MailItem
            Set curItem = curInspector.CurrentItem
     
            ' Text am Anfang der E-Mail einfügen
            curItem.HTMLBody = sBody + "<br><br><br>" + curItem.HTMLBody
        End If
    End Sub