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 (getrennte Varianten für E-Mails im „Nur Text“-Format und für E-Mails im „HTML“-Format) fügen am Anfang bzw. an der aktuellen Cursorposition [Update 19.10.2018] 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

1 – Text am Anfang der E-Mail einfügen

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

2 – Text an der aktuellen Cursorposition einfügen [Update 19.10.2018]

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 objCurInspector As Outlook.Inspector
    Set objCurInspector = Application.ActiveInspector
 
    ' Prüfen, ob Dateianhänge vorhanden sind
    If Not TypeName(objCurInspector) = "Nothing" Then
        Dim strAtts() As String
        Dim intFoundAttCount As Integer
        Dim strBody As String
 
        ' Dateianhänge auslesen
        strAtts() = getAtts()
 
        intFoundAttCount = UBound(strAtts)
 
        ' Hinzuzufügenden Text zusammensetzen
        strBody = ATTLIST_BORDER + vbCrLf
        If intFoundAttCount > 0 Then
            Dim intAttNo As Integer
 
            For intAttNo = 0 To intFoundAttCount
                ' Jeden Anhang in einer neuen Zeile aufführen
                strBody = strBody + ATTLIST_ENTRY_LINESTART + strAtts(intAttNo) + vbCrLf
            Next intAttNo
        
           strBody = strBody + ATTLIST_BORDER + vbCrLf
    
           ' Mit aktuellem E-Mail-Objekt arbeiten
           Dim objCurItem As Outlook.MailItem
           Set objCurItem = objCurInspector.CurrentItem
    
           ' Text an der aktuellen Position der E-Mail einfügen
           ActiveInspector.WordEditor.Application.Selection.TypeText vbCrLf & strBody & vbCrLf
        End If
    End If
End Sub

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

1 – Text am Anfang der E-Mail einfügen

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

2 – Text an der aktuellen Cursorposition einfügen [Update 22.10.2018]

Siehe Abschnitt „Sourcecode für E-Mails im „Nur Text“-Format“, Variante 2 – Text an der aktuellen Cursorposition einfügen [Update 19.10.2018]