VBA E-Mail Anhang speichern

VBA - Visual Basic for Application

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

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.

30 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

      1. Hallo Daniel,

        mir ist aufgefallen, dass die File Extension Case sensitive ist. Könntest du mir helfen wie mal das umgehen könnte?

        LG
        Manuel

        1. Ja, das stimmt. Es kann zum Problem werden, wenn mal die Dateiendung “*.PDF” und mal “*.pdf” oder ganz krude mal “*.PdF” heißt. Hier kannst du die Funktion LCase() verwenden. Die macht aus einem String alles Kleinschreibung (lower case)
          Als zweite Zeile vor der If-Anweisung am besten folgende Zeile einfügen, dann sollte es funktionieren:
          FileExtension = LCase(FileExtension)

        1. Hi, der oben genannten Code-Snippet für “‘Datei-Endung überprüfen” ist innerhalb der for-Schleife einzubinden und unterhalb der Anweisung
          strFile = objAttachments.Item(i).FileName
          Und innerhalb der If-Anweisung packst du dann die verbleibenden 2 Anweisungen zum Festlegen des Speicherpfads und zum Speichern der Datei.

  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

          2. Hallo Philipp,
            kam jetzt mal dazu mir deinen geposteten Kommentar und Code anzuschauen. Du hast zwischenzeitlich bestimmt schon eine passende Lösung gefunden. Ein Gesamtprojekt zu posten ist schwierig. Dazu sind die individuellen Anforderungen meistens zu konkret oder speziell. Das der Verweis auf Modul1 Probleme macht liegt sicherlich daran, dass die Methode, die du aufrufen möchtest nich in Modul1 vorhanden ist oder als private deklariert ist oder Modul1 bei dir gar nicht existiert. Den Makro-Text direkt einfügen sollte dann aber klappen. Wenn ich es richtig sehe, hast du aber versucht es mit der Methoden-Definition “Public Sub” einzufügen bzw. zusammenzufügen. Das geht nicht. Deswegen meckert der Compiler auch das ein passendes “End Sub” fehlt. Oder du hast einfach das “End Sub” am Ende von Application_NewMailEx vergessen.

  3. Hallo Daniel,
    erstmal vielen Dank für den genialen Makro des abspeicherns von Mailanhängen.
    Dieser hat bis letzte Woche super funktioniert, dann kam ein Update für office 365 und der Makro funktioniert nicht mehr.
    Er bleibt vorne stehen bei:
    Set objOL = CreateObject(“Outlook.Application”)
    Fehlermeldung:
    Fehler beim Kompilieren: Funktionsmerkmal der Objektbibliothek nicht unterstützt.

    Ich gehe davon aus, daß beim Update die Objektbibliothek verschoben wurde, oder Outlook hier andere Einträge erfahren hat.
    Hast Du einen Vorschlag, was ich hier versuchen kann.
    PS: Ich bin nur “normaler ” User, der Makros lesen kann, jedoch nicht selber schreiben kann.

    Ich danke Dir im Voraus für ein Feedback
    Tim

    1. Hallo Tim,
      ich mache zwar auch alle Updates von Office 365 mit und mein Outlook ist auf dem neusten Stand, aber dein beschriebener Fehler tritt bei mir nicht auf.
      Schaue bitte mal, ob es vielleicht an einem fehlenden Verweis liegt. Dazu im VBA-Editor Menü Extras => Verweise aufrufen. Und dann schaue mal, ob der Verweis Microsoft Outlook 16.0 Object Library und ggf. auch “Microsoft Office 16.0 Object Library” aktiviert ist. Falls nicht einmal aktivieren und probieren, ob es dann geht.
      Grüße Daniel

  4. Chapeau! Ein Super Makro.
    Da ich jetzt nicht gerade der “Crack” bin, was VBA angeht, habe ich etwas “gefrickelt”, bis ich es zum Laufen bekam, aber jetzt klappt es bestens 🙂
    Mich würde noch eines Interessieren: in diesem Makro wird ja immer nur der Anhang der aktuell ausgewählten Mail abgelegt. Kann man das auch so “umstricken”, dass alle PDF-Anhänge aller Mails eines Mail-Ordners abgelegt werden?
    Beste Grüße
    Ingo

    1. Das sollte im Prinzip jetzt auch schon funktionieren, jedoch unter der Voraussetzung, dass alle E-Mails in dem betreffenden Ordner ausgewählt/markiert sind. Das kann man recht schnell erreichen, indem man eine E-Mail markiert und dann Strg+A drückt.
      Der Makro Code ist so aufgebaut, dass alle ausgewählten E-Mail durchlaufen werden. Das ist diese Schleife hier:
      “For Each objMsg In objSelection […] Next”

  5. Hallo und vielen Dank für das Makro! Bei mir hat es allerdings nur mit der folgenden Änderung funktioniert:

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

    Ich habe zudem noch eine If Schleife reingenommen, die den Anhang-Namen überprüft, da ich das nur für bestimmte Anhänge von meinem Scanner benötige, die an die E-Mail-Adresse umgeleitet werden.

    Ich würde das Makro jetzt noch gern mit einer Regel verknüpfen, die beim Eingang von einem bestimmten E-Mail-Konto das Makro ausführt, aber das finde ich bei Office 365 nicht.

    Viele Grüße Jeannine

    1. Hallo Jeannine,
      freut mich, dass du das Makro mit “ActiveWindow” zum Laufen bekommen hast. Warum du ActiveWindow benötigst ist mir nicht ganz klar. Hast du vielleicht spezielle Einstellungen oder Ansichten deines Posteingangs?

      Ich habe auch schon mal versucht, das Makro mit einer Outlook-Regel zu verbinden, so dass es gleich bei Posteingang ausgeführt wird. Leider scheint es dafür derzeit keine Lösung im Office 365 oder auch Vorgängerversionen zu geben.
      Viele Grüße

  6. Hallo,
    ich kenne mich leider gar nicht mit VBA aus, aber bei mir macht das Makro gar nix.
    Ich habe den VBA Editor geöffnet und den Text dann unter Projekt1 – Microsoft Outlook Objekte – ThisOutlookSession eingefügt. Den Pfad auf ein Netzlaufwerk geändert und dann auf die Schnellstart Leiste.
    Wie kann ich denn herausfinden, wo das Problem liegt bzw. Fehlermeldungen anzeigen.
    Ich danke im Voraus

    1. Das ist so pauschal nur schwer nachzuvollziehen, wo da der Wurm drin steckt. Wenn keine Fehlermeldung kommt, ist die Frage, ob das VBA-Programm überhaupt ausgeführt wird oder vielleicht die entscheidenen If-Anweisungen übersprungen werden.
      Man müsste dazu das Programm debuggen: also Haltepunkte setzen und dann mit “Einzelschritt” (F8) Schritt für Schritt durchgehen und schauen was es macht. Man kann auch den Befehl Debug.Print an bestimmten Stellen einfügen und sich bestimmte Inhalten im Direktfenster/Konsole ausgeben lassen, um nachzuvollziehen, was das Programm macht.

  7. Hallo, funktioniert bisher alles ganz gut. Aber Anhänge mit dem gleichen Namen werden einfach übergangen. Wie würde eine entsprechende Erweiterung des Codes aussehen damit jeder Anhang einen Timestamp oder ein (1), (2), … ans Ende bekommt damit “Duplikate” abgespeichert werden können?

    Vielen lieben Dank für die Hilfe bisher 🙂

    1. 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 = “d:\Notablage\”

      ‘ 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

      For i = lngCount To 1 Step -1

      ‘ Dateinamen ermitteln
      strFile = objAttachments.Item(i).FileName

      lCount = InStrRev(strFile, “.”) – 1
      pre = Left(strFile, lCount)
      ext = Right(strFile, Len(strFile) – lCount)

      ‘ Pfad zusammensetzten
      strFile = strFolderpath & pre & ext

      ‘ Prüfen ob exitiert
      Dim nnumber As String
      nnumber = 0

      Do
      FileExists = Dir(strFile)

      If FileExists = “” Then
      Exit Do
      Else

      nnumber = nnumber + 1
      strFile = strFolderpath & pre & “(” & nnumber & “)” & ext

      End If
      Loop

      Debug.Print strFile

      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

  8. Hi Daniel,
    zuerst mal danke für den wirklich tollen Artikel – ist zwar nicht genau das, was ich suche, aber ich bin trotzdem “hängengeblieben” und habe das gleich ausprobiert. Funktioniert super, also vielen Dank.

    Eigentlich wäre ich auf der Suche nach einem Makro, das wahrscheinlich ziemlich einfach ausfallen wird, aber ich verzweifle daran. Habe auch versucht, mit Teilen aus deinem Aritkel hier selbst was zu bewerkstelligen, aber das klappt leider nicht. Vielleicht kannst du mir einen Tipp geben? Und zwar möchte ich durch ein Makro einer zu sendenden (also bereits geöffnete) E-Mail einfach einen (oder auch mehrere) BESTIMMTEN Anhang hinzufügen. Das mit dem normalen Einfügen…-Dialog würde ich nämlich gerne vereinfachen: Klick und gewünschte Datei als Anlage dran…
    Würde mich freuen, wenn du mir helfen kannst – vielen Dank einfach mal im Voraus.

    1. Hallo Robert,
      interessantes Thema/Fragestellung, welche du hier eingebracht hast. Damit lassen sich sicherlich einige alltägliche wiederkehrende Aufgaben in Outlook beim Einfügen von Dateien in die E-Mail optimieren.
      Ich habe dem Thema gleich mal ein eigenen Artikel gegönnt, welchen du hier unter dem Titel “VBA: Datei-Anhang in eine E-Mail einfügen” findest.
      Ich hoffe, es ist das, was du suchst und dass du dein Makro damit weiter ausbauen kannst.

  9. Hallo Zusammen

    Ich habe ein relativ einfachen VBA Code um PDFs aus mehren Emails abzu speichern.
    Leider habe ich ebenfalls das Problem, dass mir gleichnamige Datein über schrieben werden.
    Ich kenne mich leider nicht aus mit den ganzen Codes.
    Kann mir jemand helfen, im Code etwas einzubauen? Dass wenn das PDF schon existiert, eine 1,2,3… hinten anhängt.
    Hier der Code der super funktioniert:

    Sub SaveMailAttach() ‘ohne Ordner anlegen

    Dim ns As NameSpace
    Dim Ordn As Folder
    Dim Mail As MailItem
    Dim Att As Attachment
    Dim fso As Object
    Dim Pfad As String

    Pfad = Environ$(“USERPROFILE”) & “\Rechnungen Mail”

    Set ns = GetNamespace(“MAPI”)
    Set Ordn = ns.GetDefaultFolder(olFolderRssFeeds)
    Set fso = CreateObject(“Scripting.FileSystemObject”)

    ‘Start Durchsuchung Mail für Mail im Outlook Ordner
    For Each Mail In Ordn.Items

    If TypeName(Mail) = “MailItem” And Mail.Attachments.Count > 0 Then

    For Each Att In Mail.Attachments

    ‘Anhang speichern, wenn es ein pdf ist, sonst ignorieren
    If Right(Att, 3) = “pdf” Then
    Att.SaveAsFile Pfad & “\” & Att.FileName
    ElseIf Right(Att, 3) = “PDF” Then
    Att.SaveAsFile Pfad & “\” & Att.FileName
    End If

    Next Att

    End If

    Next Mail

    Set ns = Nothing
    Set Ordn = Nothing
    Set fso = Nothing

    MsgBox “Alle Mailänhänge wurden erfolgreich gespeichert unter: ” & Pfad, vbInformation

    End Sub

    1. Hi,
      hier mal ein Ansatz, der dir ggf. weiterhilft. Ob eine Datei bereits existiert kann man mit der Dir-Funktion überprüfen in VBA. Innerhalb der If-Bedingung kann man dann den Dateinamen anpassen.
      Wenn man es ganz richtig machen wollte, müsste man die Überprüfung in eine eigene Funktion packen, die sich rekursiv aufruft. Denn, wenn die Datei existiert und du den Dateinamen änderst, musst du auch die Existenz des geänderten Dateinamen überprüfen. Der könnte ja auch bereits existieren.

      If Dir(FilePath) <> “” Then
      MsgBox “This File Exists”
      ‘hier dann Dateiname ändern durch Anhängen einer Ziffer oder ähnlichem
      ‘ggf. rekursive Funktion daraus machen, um geänderte Dateinamen ebenfalls zu überprüfen.
      End If

  10. Danke für dem tollen Artikel und das Beispiel.

    3 Kleinigkeiten:

    Wie kann ich den Speicherpfad vor dem Speichern abfragen?
    Wie kann ich die Dateierweiterungen, die gespeichert werden, vor dem Speichern abfragen (beispielsweise Eingabe einer kommagetrennten Liste oder so)?
    Wie kann ich den Speicherordner, wenn er noch nicht vorhanden ist, erstellen lassen, damit es keine “Dateipfad existiert nicht” Meldung gibt. Besten Dank

    1. Hi Holger,
      zu deiner Frage, wie man den Speicherpfad abfragen kann, habe ich einen eigenen Artikel verfasst, den du unter folgenden Link erreichst: Speicherpfad über Speichern-unter-Dialog in VBA abfragen. Es erscheint dann ein Dialog, wo der Anwender einen Ordner auswählen kann, in welchem die Datei(en) gespeichert werden.
      Zu deiner zweiten Frage: Weiter oben im Kommentar-Verlauf steht ja schon an welcher Stelle man die If-Anweisung einbauen muss, um die Dateiendung abzufragen. Wenn jetzt der Anwender selbst, die Dateiendung angeben soll, könnte man das über einen eigenen Dialog/Formular im VBA abfragen. Dazu gibt es auch schon ein Post bei uns. Wenn du eine kommagetrennte Abfrage machst, musst du natürlich noch ein bisschen Code dazu schreiben. Den kommagetrennten String, kannst du dann über die Split-Funktion einem Array zuweisen. Und dieses Array lässt sich dann mit For-Next durchlaufen, um die einzelnen Dateiendungen zu überprüfen:
      strExt= "pdf,jpg,gif"
      arrayExt = Split(strExt, ",")
      For i = LBound(arrayExt, 1) To UBound(arrayExt, 1)
      'hier if-Anweisungen zu überprüfen und speichern der Dateien mit der richtigen Endung
      Next i

      Und für deine Dritte Frage hattest du ja bereits eine Lösung gefunden.

  11. Den dritten Punkt konnte ich bereits lösen:
    Neue Variable deklarieren:

    Dim objFileSystem As Object

    Dann direkt nachdem der Pfad defininiert wird, Folgendes:

    Set objFileSystem = CreateObject(“Scripting.FileSystemObject”)

    If Not objFileSystem.FolderExists(strFolderpath) Then
    objFileSystem.CreateFolder (strFolderpath)
    End If

Kommentar hinterlassen

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