VBA – Outlook: Namen der Dateien im E-Mail-Anhang auslesen

Beschreibung

In einigen Fällen ist es sinnvoll, die Namen der Dateien im E-Mail-Anhang in der E-Mail aufzulisten. Um dies zu vereinfachen, habe ich die folgende Funktion geschrieben. Die Funktion dient als Input für die Funktion Namen der Dateien im E-Mail-Anhang am Anfang der E-Mail auflisten. Alle Dateinamen im E-Mail-Anhang werden der Reihe nach ausgelesen und zusammen mit einer kurzen Einleitung (‚E-Mail-Attachments:‘ oder ‚E-Mail-Attachment:‘) als Array zurück gegeben. Der Einleitungstext ist dabei im ersten Array-Element gespeichert.

Sourcecode

Public Function getAtts() As String()
    ReDim getAtts(0)

    ' 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
        ' Mit aktuellem E-Mail-Objekt arbeiten
        Dim curItem As Outlook.MailItem
        Set curItem = curInspector.CurrentItem

        ' E-Mail-Anhänge auslesen
        Dim curAtts As Outlook.Attachments
        Set curAtts = curItem.Attachments

        ' Anzahl der E-Mail-Anhänge bestimmen
        Dim iAttCount As Integer
        iAttCount = curAtts.Count

        ' Prüfen, ob E-Mail-Anhänge vorhanden sind
        If iAttCount > 0 Then
            Dim iAttNo As Integer
            Dim sAtts() As String

            ReDim sAtts(iAttCount)

            For iAttNo = 0 To iAttCount
                If iAttNo > 0 Then
                    ' Namen der E-Mail-Anhänge auslesen
                    sAtts(iAttNo) = curAtts.Item(iAttNo).fileName
                Else
                    ' Einführungstext nach Anzahl der E-Mail-Anhänge festlegen
                    If iAttCount > 1 Then
                        sAtts(iAttNo) = "E-Mail-Attachments:"
                    Else
                        sAtts(iAttNo) = "E-Mail-Attachment:"
                    End If
                End If
            Next iAttNo

            ' E-Mail-Anhänge inkl. Einführungstext zurückgeben
            getAtts = sAtts
        End If
    End If
End Function