VBA E-Mail Anhang speichern

Outlook ist ein sehr verbreitetes Programm, insbesondere auch im beruflichen Bereich, zum Verwalten und Verarbeiten von E-Mails und natürlich noch viel mehr, wenn man nur an den Kalender und der Aufgabenverwaltung denkt.

Ein großer Vorteil von Outlook gegenüber anderen E-Mail Clients ist, dass es VBA (Visual Basic for Applications) mit bringt, wodurch sich viele zusätzliche Aufgaben automatisieren lassen, wenn die passenden Funktionen nicht auch über Outlook-Regeln und integrierte Funktionen bereits erledigt werden können.

E-Mail Anhang mit VBA automatisch speichern

Eine Aufgabe, die einen viele Klicks sparen kann, ist das Speichern von E-Mail Anhängen. Hat man typische wiederkehrenden E-Mails, deren Anhang immer unter denselben Pfad zu speichern ist, so muss man sich jedesmal zu diesem Pfad mit dem “Speichern unter“-Dialog durchklicken.

Mittels VBA kann man sich ein Makro schreiben, um den E-Mail Anhang zu speichern. Dem Makro kann man dann auch noch ein Shortcut zuweisen oder ein Button in der Leiste für den Schnellzugriff einfügen. So benötigt man schließlich nur noch einen Klick oder Tastendruck, um den Anhang der Mail zu speichern. Ein solches Makro lässt sich auch mit weiteren Makros kombinieren, so dass zum Beispiel gleichzeitig der E-Mail-Anhang per VBA gedruckt wird.

Bestseller Nr. 1
Checklisten-Buch: DIN A4 • 70+ Seiten,...
  • To Do-Planer, #GoodMemos (Autor)
  • 88 Seiten - 30.10.2017 (Veröffentlichungsdatum) - CreateSpace Independent Publishing Platform...

VBA-Code zum Speichern Outlook E-Mail Anhang

Mit dem folgenden VBA Code lassen sich die E-Mail Anhänge unter einem fest vorgegebenen Ordnerpfad ablegen. Es werden dabei nur die E-Mail Anhänge der jeweils ausgewählten Mail gespeichert.

In Outlook gelangt man zum Visual Basic Editor durch die Tastenkombination Strg+F11. Es geht auch über das Menü Entwicklertools ⇒ Visual Basic.


Public Sub SaveAttachments()

    Dim objOL As Outlook.Application
    Dim objMsg As Outlook.MailItem
    Dim objAttachments As Outlook.Attachments
    Dim objSelection As Outlook.Selection
    Dim i As Long
    Dim lngCount As Long
    Dim strFile As String
    Dim strFolderpath As String
    
    ' Outlook Application Objekt instanziieren
    Set objOL = CreateObject("Outlook.Application")
    
    ' Collection der ausgewählten Objekte (E-Mails) ermitteln
    Set objSelection = objOL.ActiveExplorer.Selection
    
    ' Ordner-Pfad festlegen, wo der E-Mail Anhang gespeichert werden soll
    strFolderpath = "c:\Users\AnyUser\Documents\unterordner\rechnungen\jahr_2020\"
    
    ' Jedes ausgewählten Objekte (E-Mails) prüfen, ob es einen Anhang hat. Wenn Anhang vorhanden,
    ' dann unter dem Ordnerpfad speichern.
    For Each objMsg In objSelection
    
        ' Die Anhänge des ausgewählten Objekts (E-Mail) ermitteln
        Set objAttachments = objMsg.Attachments
        lngCount = objAttachments.Count
    
        If lngCount > 0 Then
    
            ' Wir verwenden hier einen rückwärts gerichteten Zähler; umgekehrt sollte es aber auch funktionieren.
    
            For i = lngCount To 1 Step -1
    
                ' Save attachment before deleting from item.
                ' Dateinamen ermitteln
                strFile = objAttachments.Item(i).FileName
    
                ' Kombiniere Ablagepfad mit dem Dateinamen
                strFile = strFolderpath & strFile
    
                ' Anhang als Datei speichern
                objAttachments.Item(i).SaveAsFile strFile
    
            Next i
    
        End If
    Next
    
ExitSub:
    Set objAttachments = Nothing
    Set objMsg = Nothing
    Set objSelection = Nothing
    Set objOL = Nothing
End Sub

Outlook Makro über Schnellzugriff aufrufen

Aufrufen bzw. Ausführen kann man nun das Makro, vorausgesetzt es ist Public, über die Entwicklertools ⇒ Makro ⇒ Makros-Dialog. Oder man legt sich einen Button in dem Schnellzugriff ab. Über den kleinen Pfeil nach unten im Schnellzugriff wählt man “Weitere Befehle …” aus oder man geht über Datei ⇒ Optionen ⇒ Symbolleiste für den Schnellzugriff.

Screenshot Outlook Schnellzugriff Button zum Ausführen des Makros zuweisen
Outlook Schnellzugriff Button zum Ausführen des Makros zuweisen

In dem sich dann öffenenden Dialog-Fenster schränkt man die Befehle auf Makros ein und fügt das betreffende Makro hinzu.

Screenshot Outlook-Optionen Symbolleiste für den Schnellzugruff
Makro auswählen und über den Hinzufügen-Button dem Schnellzugriff ermöglichen

Über den Button “Ändern” kann man dann noch ein Icon vergeben oder den Text anpassen.

Bestseller Nr. 1
Go! With Mircrosoft Office Excel 2003: Brief-...
  • Gaskin, Shelley (Autor)
  • 296 Seiten - 01.12.2003 (Veröffentlichungsdatum) - Pearson (Herausgeber)
Bestseller Nr. 2

7 Kommentare

  1. Hallo zusammen,

    erst einmal vielen Dank für das Makro! Funktioniert super!
    Bei mir werden nun leider auch Bilder/ Icons aus der Mail mit heruntergeladen…
    Kann man dies umstellen, sodass nur noch Anhänge (vor allem pdf.) heruntergeladen werden?

    Grüße
    Finn

    1. Hallo Finn,

      ja in dieser Variante werden alle Dateien in der E-Mail gespeichert. Das ist natürlich in manchen Fällen ungünstig, weil viele auch ein Logo oder andere Bilder, bis hin zu TrackingPixel in den Mails und deren Signaturen speichern. Man kann aber den VBA-Code erweitern, indem man die Dateiendung (File Extension) ermittelt und dann zum Beispiel über eine if-Anweisung abfragt, ob es sich um eine PDF-Datei handelt. Hier der Code. Die Anweisung objAttachments.Item(i).SaveAsFile muss also vom if-Statement eingefasst werden.


      'Datei-Endung überprüfen
      FileExtension = Right$(strFile, Len(strFile) - InStrRev(strFile, "."))
      If FileExtension = "pdf" Then
      ' Anhang als Datei speichern
      objAttachments.Item(i).SaveAsFile strFile
      End If

  2. Hallo Daniel,

    mega praktisches Makro. Vielen Dank.

    Kann man das Makro auch so umbauen, dass es automatisch Anhänge abspeichert, die vo bestimmten Empfängern kommen?
    Die gängigen Tools dafür kann ich in meiner Firma nicht installieren und ebenso kann ich nicht an die Windows Registry ran.

    Falls das nicht gehen sollte: Kann ich ggf. alle Anhänge aus einem bestimmten Outlook Ordner automatisch runterladen?

    Danke dir!

    1. Hallo Philipp,

      eine fertige Lösung habe ich nicht bzw. wären diese einen eigenen Blog-Artikel wert, den ich vielleicht auch noch erstelle nach deiner Anregung 😉
      Erste Idee ist es die Ausführung des Makros über die Outlook-Regeln zu bewerkstelligen mittels der Regel “Nach Erhalt einer Nachricht von … ein Skript ausführen“. Dies Regel ist aber in neueren Outlooks nicht mehr verfügbar. Wird wohl also nicht funktionieren.
      Ein anderer Ansatz ist über das Application. NewMail-Ereignis das Eintreffen einer neuen Mail im VBA abzufangen und dann per VBA den Sender zu ermittlen und dann weiteren Code auszuführen. Aber das habe ich selbst noch nicht bisher getestet.

      1. Hallo Daniel,

        danke dir für das schnelle Feedback.
        Den BVA mittels ein Skript ausführen hatte ich mal genutzt. Nur wie du sagst, geht das mit meinem neuem Outlook in der Firma nicht mehr.

        In weiteren Foren habe ich bereits den Tipp mit dem New.mail makro entdeckt.
        https://docs.microsoft.com/de-de/office/vba/api/outlook.application.newmail?redirectedfrom=MSDN

        Leider fehlen mir dafür die Skills das entsprechende Makro zu erstellen. Deswegen bin ich verzweifelt auf der Suche und wäre für jede Hilfe dankbar.

        Danke!

        LG

          1. Hallo Daniel,

            vielen Dank für den Extra Artikel und deine ganze Mühe! Ich habe diesen entsprechend implementiert. Leider bekomme ich immer einen Fehler beim kompilieren. Gibt es hier ggf. einen GesamtVBA den du einmal exemplarisch einfügen könntest?
            Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
            Dim Item As Object
            Dim Email As String
            Set Item = Session.GetItemFromID(EntryIDCollection)
            Item.Save
            ‘Absender E-Mail Adresse ermitteln
            Email = Item.SenderEmailAddress
            ‘Überprüfen, ob E-Mail von bestimmten Absender
            If Email = “vorname.nachname@ekiwi.de” Then
            ‘weiteren Code und Makros hier ausführen
            Modul1.MeinMakro
            Debug.Print “Die richtige Mail lautet: ” + Email
            Else
            Debug.Print “Falsche Mail lautet: ” + Email
            End If
            End Sub

            Wenn ich den Verweis auf Modul 1 mache, dann kann er es immer nicht greifen. Wenn ich den Makro Text von oben direkt einfüge, klappt es leider ebensowenig: Dann bekomme ich den Fehler, dass EndSub fehlt.

            Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
            Dim Item As Object
            Dim Email As String
            Set Item = Session.GetItemFromID(EntryIDCollection)
            Item.Save
            ‘Absender E-Mail Adresse ermitteln
            Email = Item.SenderEmailAddress
            ‘Überprüfen, ob E-Mail von bestimmten Absender
            If Email = “vorname.nachname@ekiwi.de” Then
            ‘weiteren Code und Makros hier ausführen
            Public Sub SaveAttachments()

            Dim objOL As Outlook.Application
            Dim objMsg As Outlook.MailItem
            Dim objAttachments As Outlook.Attachments
            Dim objSelection As Outlook.Selection
            Dim i As Long
            Dim lngCount As Long
            Dim strFile As String
            Dim strFolderpath As String

            ‘ Outlook Application Objekt instanziieren
            Set objOL = CreateObject(“Outlook.Application”)

            ‘ Collection der ausgewählten Objekte (E-Mails) ermitteln
            Set objSelection = objOL.ActiveExplorer.Selection

            ‘ Ordner-Pfad festlegen, wo der E-Mail Anhang gespeichert werden soll
            strFolderpath = “c:\Users\AnyUser\Documents\unterordner\rechnungen\jahr_2020\”

            ‘ Jedes ausgewählten Objekte (E-Mails) prüfen, ob es einen Anhang hat. Wenn Anhang vorhanden,
            ‘ dann unter dem Ordnerpfad speichern.
            For Each objMsg In objSelection

            ‘ Die Anhänge des ausgewählten Objekts (E-Mail) ermitteln
            Set objAttachments = objMsg.Attachments
            lngCount = objAttachments.Count

            If lngCount > 0 Then

            ‘ Wir verwenden hier einen rückwärts gerichteten Zähler; umgekehrt sollte es aber auch funktionieren.

            For i = lngCount To 1 Step -1

            ‘ Save attachment before deleting from item.
            ‘ Dateinamen ermitteln
            strFile = objAttachments.Item(i).FileName

            ‘ Kombiniere Ablagepfad mit dem Dateinamen
            strFile = strFolderpath & strFile

            ‘ Anhang als Datei speichern
            objAttachments.Item(i).SaveAsFile strFile

            Next i

            End If
            Next

            ExitSub:
            Set objAttachments = Nothing
            Set objMsg = Nothing
            Set objSelection = Nothing
            Set objOL = Nothing
            End Sub
            Debug.Print “Die richtige Mail lautet: ” + Email
            Else
            Debug.Print “Falsche Mail lautet: ” + Email
            End If
            End Sub

Kommentar hinterlassen

Deine E-Mail-Adresse wird nicht veröffentlicht. Erforderliche Felder sind mit * markiert.