Bei Ihnen trudeln haufenweise E-Mails ein, deren Anhänge Sie dann ablegen müssen – und zwar jedes Mal in den gleichen Ordner?
Das lässt sich automatisieren. Mit ein bisschen VBA – nicht erschrecken, ich zeig Ihnen, wie Sie das einrichten:
Öffnen Sie den VBA-Editor in Outlook (dazu drücken Sie die Tastenkombination Alt+F11).
Fügen Sie ein neues Modul hinzu. Dazu klicken Sie im Projekt-Explorer, den Sie links im Fenster finden, mit der rechten Maustaste auf den Eintrag Projekt1, wählen dann Einfügen und dann Modul.
In das große leere Feld rechts fügen Sie nun Folgendes ein:
Public Sub Anhaenge_handeln(myItem As Outlook.MailItem) Dim mAtts As Attachments Dim mAtt As Attachment Set mAtts = myItem.Attachments While mAtts.Count > 0 Set mAtt = mAtts(1) mAtt.SaveAsFile "C:\meinSpeicherort\" & mAtt.DisplayName mAtts.Remove 1 Wend End Sub
Ersetzen Sie darin C:\meinSpeicherort durch das Verzeichnis, in das Sie die Anhänge speichern wollen. Speichern Sie – durch Klick auf die Diskette (wie altmodisch!) oder mit der Tastenkombination Strg+S.
Schließen Sie den VBA-Editor.
Öffnen Sie den Regel-Manager mit START > Verschieben > Regeln > Regeln und Benachrichtigungen verwalten … und klicken Sie auf Neue Regel. Im Regel-Assistent klicken Sie im Feld 1. Schritt auf Regel ohne Vorlage erstellen > Regel auf von mir empfangene Nachrichten anwenden, und dann auf Weiter >.
Nun bestimmen Sie die Bedingung, unter der Sie die automatische Anhangspeicherung vornehmen wollen (z.B. alle Mails von einem bestimmten Empfänger, mit einem bestimmten Schlüsselwort, …). Weiter >.
Unter 1. Schritt: Aktionen auswählen haken Sie nun ein Skript ausführen an (dazu müssen Sie eventuell ein bisschen hinunterscrollen), dann klicken Sie auf den unterstrichenen Text ein Skript, und jetzt wählen Sie in der Skriptliste Anhaenge_handeln aus. Ok. Weiter >. Weiter >. Fertigstellen.
Viel Freude mit der neuen Automatik!
katharinakanns
Soprani Software 
Hallo Karin,
ich finde den Blog super. Attachements + Emails strukturiert in generierten Unterverzeichnissen abzulegen ist für uns in Projekten sehr wichtig. Eine schlanke Lösung (bzw. in Kombination mit Regeln) wie hier bevorzuge ich aber.
Folgender Wunschablauf:
-) Ablage von Attachements in ein Zielverzeichnis mit generiertem Unterverzeichnis (Format: yyyymmdd_Betreff_Absender\); Bei Betreff wäre gut limitieren zu können 😉 (z.B. 20 Zeichen)
-) Email in das gleiche generierte Unterverzeichnis ablegen (Attachements abgetrennt , Emails als .msg oder .eml). Das Email kann aber den gleichen Namen wie das Unterverzeichnis haben (Datum_Betreff_Absender\).
-) Falls gleiche Dateinamen bei den Attachments: zusätzliche Nummer oder Zeitstempel anhängen
(aber die Lösung habe ich hier schon gesehen 🙂 ).
Ich habe Dir auch schon eine Anfrage geschickt. Aber bis jetzt keine Antwort erhalten ;-).
Danke & lg aus Graz
Hermann
LikeLike
PS: hätte ja auch unsere Website angegeben. Aber dann wird der Kommentar nicht angeschickt. Ohne Website ging es dann ;-).
LikeLike
PPS: meinte natürlich Katharina, Karin war ein Freud’scher Verschreiber :-).
LikeLike
🙂 Kein Problem, bei „Martha“ wär ich irritiert gewesen, „Karin“ bin ich gewöhnt 🙂
Mail ist geschrieben. Danke fürs Erinnern. Es war zu viel los hier …
LikeLike
funktioniert leider nicht mehr ab Outlook 2013. Gibt es hierfür eine Alternative? (Emails werden mit Regel in bestimmten Ordner verschoben und nur die Anhänge dieser Mails sollen abgespeichert werden
LikeLike
Hallo,
wie zeigt sich denn dieses „funktioniert nicht mehr“?
Grundsätzlich klappt das auch in Version 2019 noch, es liegt also nicht ursächlich an der Version, wobei natürlich bei einer Versionsänderung manche Parameter verstellt werden (ärgerlicherweise).
lg
Katharina
LikeLike
Hallo, ich habe das Skript über den VBA Editor erstellt, wenn ich jetzt eine Regel erstellen will, erscheint mir unter dem 2. Aktion NICHT der Punkt mit dem Skript ausführen ?!??! Was tun ?
Danke Swen
LikeLike
Hallo Swen,
scroll in den Kommentaren ein bisschen höher; das ist schon beschrieben.
lg
Katharina
LikeLike
Hallo Katharina,
ich nutze Outlook 2016 in Office365 m. Exchange und habe versucht das Script über den Regelassistenten aufführen zu lassen.
Die erste Hürde war in der Registry nötig, dort habe ich in HKCU „EnableUnsafeClientMailRules“ eingefügt, um die in Outlook 2016 verschwundene Aktion „Skript ausführen“ wieder im Regelassistenten sichtbar zu machen.
Die neue Regel mit aktiviertem Skript läuft aber sie führt nichts aus, im lokalen Verzeichnis auf USB Datenträger wird nichts gespeichert.
Wie kann ich prüfen woran es liegt, kann ich sehen wo das Skript hängt oder warum es nicht zur Speicherung von Anlangen kommt?
Danke vorab 😉
LikeLike
Hallo, gibt es hier schon eine Lösung?
vielen Dank
LikeLike
Hallo Jens,
das ist sehr schwer zu sagen – es könnten Makros wieder deaktiviert sein, die muss man zumeist bei jedem Neustart von Outlook zulassen (je nach Einstellung), es kann per Group Policy verunmöglicht worden sein, … Ferndiagnose geht da nicht mehr.
Leider keine bessere Nachricht 😦
herzliche Grüße
LikeLike
Hallo Katharina,
immer noch toller Blog – ich hab das jetzt so gelöst, da ich es auf Knopfdruck brauche und mir sonst die gleichen PDF’s überschrieben werden:
Public Sub Anhaenge_handeln(myItem As Outlook.MailItem)
Dim mAtts As Attachments
Dim mAtt As Attachment
Set mAtts = myItem.Attachments
While mAtts.Count > 0
Set mAtt = mAtts(1)
mAtt.SaveAsFile „C:\meinOrdner\“ & Format(Now, „yyyymmdd hhmmss“) & Strings.Right(Strings.Format(Timer, „#0.00“), 2) & mAtt.DisplayName
mAtts.Remove 1
Wend
End Sub
aber die Schleife damit nur PDF’s reinlaufen, habe ich leider nicht hinbekommen.
Kannst du mir da eve noch kurz helfen?
‚If Right(mAtt.DisplayName, 4) = „.pdf“ Then mAtt.SaveAsFile „C:\MeinOrdner\“ & mAtt.DisplayName“
LikeLike
Guten Morgen, Florian,
danke für das Lob 🙂
Mit dem Schnipsel hier werden nur pdfs „behandelt“ und auch nur pdfs gelöscht:
Dim numAtt As Long
numAtt = 1
Set mAtts = myItem.Attachments
While mAtts.Count > numAtt – 1
Set mAtt = mAtts(numAtt)
If LCase(Right(mAtt.DisplayName, 4)) = „.pdf“ Then
mAtt.SaveAsFile „C:\“ & Format(Date, „yyyymmdd“) & „_“ & myItem.Sender & „_“ & Format(myItem.ReceivedTime, „yyyymmdd“) & „_“ & mAtt.DisplayName
mAtt.Delete
Else
numAtt = numAtt + 1
End If
Wend
Viel Erfolg!
lg Katharina
LikeLike
Hallo Katharina,
Ich hab dasselbe Problem wie Ingo (siehe Kommentar vom 07.01.2020)
Das Problem mit der fehlenden Aktion „Skript ausführen“ hatte ich auch gelöst.
Allerdings werden bei mir auch keine empfangenen Excel-Datei in einem vorgegebenen Ordner gespeichert.
Vielen Dank schonmal für deine Rückmeldung
LikeLike
Hallo Steffen,
passiert einfach gar nichts? Keine Fehlermeldung, aber auch kein Speichern, und die Datei bleibt erhalten?
lg Katharina
LikeLike
Hallo Katharina,
vielen Dank für die guten Erklärungen, ich habe es nach deiner Anleitung umgesetzt und es tut auch was es soll.
Allerdings habe ich ein weiterführendes Problem:
Von manchen Kollegen kommt eine Mail mit mehreren Anhängen, die nach Möglichkeit alle in unterschiedliche Ordner sollten. Manche Anhänge davon sollen aber auch gar nicht erst gespeichert werden. Zudem müssten die Anhänge noch unter einem bestimmtem Namen, je nach Originalname abgespeichert werden.
Ist das alles irgendwie machbar?
Viele Grüße!
Nico
LikeLike
Hallo Nico,
das ist machbar – es stecken hier in den Kommentaren schon die richtigen Codeschnipsel zum Ausschließen bestimmter Dateien oder Dateiformate, und zur Unterscheidung für unterschiedliche Behandlungs“methoden“ – z.B. unterschiedliche Ordner.
Wichtig ist dafür die Arbeit, bevor die Programmierung beginnt: eine genaue Definition, woran das Programm erkennen soll, was es tun soll.
lg
Katharina
LikeLike
Hallo Katharina !
Ich habe schon vor einigen Jahren diese Applkation nutzen wollen, bin aber gescheitert (seither erhalte ich alle eure Korrespobndenz zu diesem Thema, habe aber damals das Problem anders gelöst). Jetzt ist das Problem wieder aktuell. Kein Problem das Madul zu erstellen und eine Regel zu erstellen. Aber in der Auswahl der Aktion die ausgeführt werden soll wird die Option „Skript ausführen“ nicht angezeigt (leider kann ich keinen screenshot des Bidschirms senden). Was kann ich tun ? Ich habe Win10, Windows365. vorher war es win8, win 7 und entsprechand anderes Office. Ich konnte es nie zum Laufen bringen…
Danke für einen Hinweis
LikeLike
Hallo Reinhard,
Lösungsvorschlag 1:
Hast du im Fenster mit den möglichen Aktionen nach unten gescrollt? Der Eintrag „ein Skript ausführen“ ist auf den ersten Blick nicht ersichtlich.
Lösungsvorschlag 2:
Unter Optionen>TrustCenter>Einstellungen für das Trust Center>Makroeinstellungen die Sicherheitsstufe runtersetzen, da dein Makro vermutlich keine Signatur hat. Danach Outlook neu starten und es sollte funktionieren
Lösungsvorschlag 3:
Sonst wird es mühsam – da ist wahrscheinlich die Registry verhunzt. Sollzustand:
Windows Registry Editor Version 5.00
[HKEY_CURRENT_USER\Software\Microsoft\Office\16.0\Outlook\Security]
„EnableUnsafeClientMailRules“=dword:00000001
und hier der Link zum Artikel bei Microsoft:
https://answers.microsoft.com/en-us/msoffice/forum/msoffice_outlook-mso_win10/the-option-to-run-a-scritp-has-disappeared-from/d289e698-47fa-497a-80fa-633067a0de37#ThreadAnswers
lg Katharina
LikeLike
Danke. Die Vorschläge 1+2 haben erwartungsgemäß keinen Erfolg gehabt. Aber der Eintrag hat in der Registry gefehlt, ich habe ihn eingetragen und jetzt kann ich „ein Skript“ ausführen anklicken und das skript anwählen. Alles läuft wie versprochen und erwünscht. Danke.
LikeLike
Prima das Script.
Funktioniert einwandfrei.
Dankeschön.
Wir mußten nur die Makrosicherheit etwas runter schrauben.
LikeLike
Hallo,
ich versuche auch seit einer Weile diese Funktion zu hinterlegen aber irgendwie wird es nicht ausgeführt, also es kommt eine neue Email an, aber der Anhang wird nicht abgelegt.
LikeLike
Hallo Daniel,
das Skript macht auch noch keine Automatik – da müsstest du noch eine Regel ergänzen, die das startet. Wie das geht, steht schon in den Kommentaren 🙂
lg
Katharina
LikeLike
Hallo, ich habe eine Regel erstellt, diese fragt einmal um makros zu aktivieren, nach Aktivierung funktioniert es dann, aber am nächsten Tag ist die Regel verschwunden.
LikeLike
Dann hat es noch was in den Sicherheitseinstellungen … dazu gibt es in den Kommentaren schon eine Menge Infos zu den verschiedenen Versionen von Outlook.
LikeLike
Sehr gute Bescheibung bzw Lösung… Läuft auch, allerdings werden die Datein immer überschrieben, denn jede Mail hat ein 3er Set Nilder von meiner HikVision Camera im Anhang.
Eine Ablage nach Datum und Nummerierung 0 bis x würde ich mir wünschen.
Wer kann absolutem Beginner helfen? 😉
LikeLike
Hallo,
da muss die Zeile mit der Speicherung ein bisschen „aufgeblasen“ werden:
mAtt.SaveAsFile „C:\meinSpeicherort\“ & Format$(date(), "yyyymmdd") & "_" & mAtts.Count & "_" & mAtt.DisplayNameJetzt kommt das aktuelle Daum dazu, und eine laufende Nummer (von 3 bis 1).
lg
Katharina
LikeLike
Super Blog und tolle Erklärung. Gibt es denn auch die Möglichkeit das die Anhänge nicht von der entsprechenden E-Mail gelöscht werden sondern das diese dort weiter als Anhang weiterbestehen und diese zusätzlich in den entsprechenden Ordner gespeichert werden?
LikeLike
Statt
While mAtts.Count > 0Set mAtt = mAtts(1)
mAtt.SaveAsFile „C:\meinSpeicherort\“ & mAtt.DisplayName
mAtts.Remove 1
Wend
sollte das klappen:
Dim I as longFor I = 1 to mAtts.Count
Set mAtt = mAtts(I)
mAtt.SaveAsFile „C:\meinSpeicherort\“ & mAtt.DisplayName
Next I
lg
Katharina
LikeLike
Vielen Dank für das tolle Script und den Support, Katharina!
Ich musste etwas googeln, weil mir bei dem Script ein Fehler (die Klammern um den Speicherort fehlten) angezeigt wurde. Damit andere das nicht tun müssen:
Public Sub Anhaenge_handeln(myItem As Outlook.MailItem)
Dim mAtts As Attachments
Dim mAtt As Attachment
Set mAtts = myItem.Attachments
Dim I As Long
For I = 1 To mAtts.Count
Set mAtt = mAtts(I)
mAtt.SaveAsFile („C:\meinSpeicherort\“) & mAtt.DisplayName
Next I
End Sub
Damit klappt jetzt alles wunderbar und die Mails bleiben, samt Anhang, wo sie waren 🙂
LikeLike
Hallo Katharina,
ich habe nach deiner Anleitung das Script erstellt und es funktioniert wurderbar.
Wie kann man erreichen, dass die Datei unter einem bestimmten Namen abgespeichert wird und die vorhandene Überschrieben?
Vielen Dank!
LikeLike
Hallo Katharina,
es geht zwar nicht direkt um dein Script hier, aber um eine Abwandlung.
Bis 1.11. hat folgendes Script noch voll funktioniert:
Public Sub Telekom_Anhang(olc As Outlook.MailItem)
Dim attach As Attachment
Dim Now As Variant
Dim FileName As String
Dim pfad As String
Dim i As Integer
pfad = „E:\Daten\TEXTE\privat\Telekom\“
If olc.Attachments.Count > 0 Then
For Each attach In olc.Attachments
If Right(attach.FileName, 4) = „.pdf“ Then attach.SaveAsFile (pfad & Format(olc.ReceivedTime, „yyyy_mm_dd_“) & attach.FileName)
Next attach
End If
End Sub
Aufgerufen beim anlegen der Regel.
Heute kam eine Mail, wo der Anhang hätte gespeichert werden müssen. Aber nix, keine Speicherung, auch nicht beim manuellen ausführen beim speichern der Regel.
Kannst du helfen, wo der Fehler liegt?
Es passiert nix, keine Fehlermeldung, keine Speicherung. Die Regel selber läuft aber durch.
Vielen Dank!
Christian
LikeLike
Hallo Christian,
ich hab das jetzt einmal getestet, und (das willst du nicht hören, aber leider) bei mir funktioniert es, halt mit einem anderen Pfad. Du sagst, die Regel läuft durch, Hast du schon mal mit einem Breakpoint im Code versucht, zu schauen, ob das Sub wirklich gestartet wird?
lg
Katharina
LikeLike
Moin Katharina,
besten Dank für die tolle Erklärung und auch die Mühe bei dauerhaften Sichten der Kommentare, sogar fünf Jahre nach Thread-Erstellung.
Ich fürchte zwar die Antwort schon zu kennen, aber folgendes Problem habe ich: Da ich an einem Arbeitsrechner sitze, kann ich nicht auf die registry zugreifen, das müsste über den technischen Helpdesk laufen. Leider wird aber auch mir bei der Regelerstellung im zweiten Schritt „Skript ausführen“ nicht angezeigt. Gibt es einen Weg das ohne reg-Eintrag zu beheben? Die Makroeinstellungen im Trust-Center sind auf „alle Makros zulassen (nicht empfohlen)“ gesetzt, ich denke das ist schon die höchste Stufe.
Lieben Dank und viele Grüße
Korbinian
LikeLike
Oje,
wenn das TrustCenter schon ausgereizt ist und die registry so nicht möglich, dann hilft wohl nur ein Appell an die IT, dass sie das zulässt (ist oft vergeblich, ich weiß).
lg und danke für die Anerkennung – sowas freut mich 🙂
Katharina
LikeLike
Hallo Katharina
Ich habe noch eine Frage zu deinem Code.
Kann man auch nur die Anhänge von Mails in einem bestimmten Outlook Ordner automatisch speichern oder geht das nur vom Eingangsordner?
Wir haben jeweils mehrere Projekte und möchten gerne jeweils die E-Mails in die Projektordner im Outlook ablegen und von da die Anhänge in die Projektordner im Ablagesystem speichern.
Kannst du mit da weiterhelfen?
LG Stefan
LikeLike
Hallo Stefan,
hier wird das gerade markierte E-Mail „behandelt“, egal, in welchem Ordner es liegt.
Da wäre also gar nichts zu tun, damit das funktioniert.
Und bei der Variation mit „alle Mails durchsuchen“ muss halt der entsprechende Ordner eingegeben werden, oder – in deinem Fall – alle Projektordner durchlaufen werden.
lg
Katharina
LikeLike
Hallo Katharina!
Könnte man so ein Skript auch für bestehende eMails umschreiben?
Ich habe einen Postfach-Ordner, in dem bereits ganz viele eMails mit CSV Anhang liegen. Diese würde ich gerne mit einem Skript auf z.B. C:\OrdnerXYZ kopieren. Für alles weitere was dann kommt, würde ich das oder die Skript oben nutzen wollen.
Danke im Voraus!
Gruß
Matthias
LikeLike
Hallo Matthias,
das geht zum Beispiel mit
Public Sub Inbox_Anhaenge_handeln()
Dim myItem As Outlook.MailItem
Dim olNameSpace As Outlook.NameSpace
Dim olFolder As Outlook.Folder
Dim olItems As Outlook.Items
Set olNameSpace = GetNamespace(„MAPI“)
Set olFolder = olNameSpace.GetDefaultFolder(olFolderInbox)
Set olItems = olFolder.Items
For Each myItem In olItems
Call Anhaenge_haendeln(myItem) ‚!!! oder eine andere Prozedur – halt eine, die genau das tut, was du möchtest
Next myItem
Set myItem = Nothing
Set olItems = Nothing
Set olFolder = Nothing
Set olNameSpace = Nothing
End Sub
!! Das hier durchläuft den Posteingang ohne Unterordner, und die Prozedur Anhaenge_haendeln aus dem Blogpost entfernt die Anhänge nach dem Ablegen. Wenn das anders aussehen soll (nur ein konkreter Ordner, nicht löschen, sondern nur ablegen, …) muss der Code adaptiert werden; Beispiele dazu sind zT ebenfalls hier zu finden.
lg
Katharina
LikeLike
Hallo Katharina,
lieben Dank für das Script.
Eine Frage hätte ich (sie wurde auch bereits gestellt, ich habe in den Kommentaren leider keine Antwort gefunden, weswegen ich Dich „belästige“ 😉 ). Ist es möglich, den Dateinamen aus dem Betreff zu nehmen?
Ich bekommen Bilder geschickt, wo im Betreff vermerkt ist, um welchen Kunden & welchen Auftrag es sich handelt. Da wäre es sehr hilfreich den Betreff auslesen zu können.
Tante Google hat mir leider auch nicht wirklich weiterhelfen können.
Wünsche Dir ein schönes Wochenende & liebe Grüße
Ramona
LikeLike
Hallo Ramona,
ha, das geht 🙂
Der Betreff steht in dieser Eigenschaft:
myItem.Subject
und damit könnte die Zeile z.B. lauten:
mAtt.SaveAsFile „C:\meinSpeicherort\“ & myItem.Subject & “ “ & mAtt.DisplayName
Herzliche Grüße und ebenfalls ein schönes Wochenende!
Katharina
LikeLike
Hallo,
ich hatte dieses Script seit Jahren im Einsatz, aber jetzt nach dem Umstieg auf office2019 habe ich auch diese Funktion „führe script aus“ in den Regeln nicht mehr.
Der Eintrag in der Registry ist gemacht, aber der Punkt erscheint nicht mehr in der Auswahlliste.
Echt schade.
Irgendeine Idee?
Gruß
Jürgen
LikeLike
Die Problemstellung war: Wie kann man eine Kolonne von ca. 1.200 personenbezogenen Daten, wo sowohl Vor-und Nachname, gefolgt auf die nächste Position, die bisher nur jeweils durch ein Leerzeichen getrennt waren, über die Word-Funktion „Ersetzen“ individuell mit Semikolon zu trennen, ohne die verbleibenden Leerzeichen anzusteuern.
Frau Schwarz hat mir bei dieser Aufgabe schnell, unbürokratisch und visuell sehr geholfen. Und mir viel Aufwand erspart – vielen Dank dafür.
LikeLike
Pingback: EMAIL ANHÄNGE AUTOMATISCH SPEICHERN – Erhard RAINER
Oh, man, das ganze macht mir graue Haare ohne Ende.
Ich versuche die ganze Zeit das nach den Anleitungen hier hin zu bekommen aber es klappt nicht.
Mein Problem: Ich bekomme Mails mit einem PDF-Anhang, alle mit gleichen Dateinamen. Diese sollen in einen (Hotfolder-)Ordner mit unterschiedlichen Dateinnamen. Im Betreff unterscheiden sich die Mails in den letzten 10 Zeichen, die Zeichen davor sind immer gleich.
Ich bekomme es aber nicht hin das die Dateien entsprechend abgelegt werden. Entweder macht Outlook nur eine Datei die laufend überschrieben wird, mäkelt an das myItem.Subject falsch geschrieben ist, oder speichert erst gar nicht im Ordner.
Dann will Outlook auch noch jedes mal eine Neustart wenn ich was am Code geändert habe.
Und Dummerweise ist im Subject auch noch ein Doppelpunkt mit drin.
Mein Code sieht so aus
Public Sub Anhaenge_handeln_Hotfolder(myItem As Outlook.MailItem)
Dim mAtts As Attachments
Dim mAtt As Attachment
Set mAtts = myItem.Attachments
Dim I As Long
For I = 1 To mAtts.Count
Set mAtt = mAtts(I)
mAtt.SaveAsFile „C:\test\“ & myItem.Subject & „_“ & mAtt.DisplayName
Next I
End Sub
LikeLike
Versuch’s mal so:
mAtt.SaveAsFile „C:\test\“ & makeSaveName(myItem.Subject) & „_“ & mAtt.DisplayName
und weiter unten dann
Public Function makeSaveName(myText As Variant) As Variant
Dim Pos As Long
Dim Chars As Variant
For Pos = 1 To Len(myText)
If InStr(1, „abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ -_äöüÄÖÜß0123456789“, Mid(myText, Pos, 1)) 0 Then
makeSaveName = makeSaveName & Mid(myText, Pos, 1)
End If
Next Pos
End Function
Damit wird aus dem Betreff alles entfernt, was als Dateiname ungeeignet ist, und es bleiben nur zulässige Zeichen übrig.
LikeGefällt 1 Person
Nanu? Wenn ich nochmal antworte auf Deine Antwort geht das unter oder wird es mir nur nicht angezeigt?
Ich also nochmal. Ich bekommen immer inen Syntaxfehler in der saveasfile-zeile
Aber ich seh keinen.
Hier nochmal das ganze Modul
Public Sub Anhaenge_handeln_Hotfolder(myItem As Outlook.MailItem)
Dim mAtts As Attachments
Dim mAtt As Attachment
Set mAtts = myItem.Attachments
Dim I As Long
For I = 1 To mAtts.Count
Set mAtt = mAtts(I)
mAtt.SaveAsFile „C:\test\“ & makeSaveName(myItem.Subject) & „_“ & mAtt.DisplayName
Next I
End Sub
Public Function makeSaveName(myText As Variant) As Variant
Dim Pos As Long
Dim Chars As Variant
For Pos = 1 To Len(myText)
If InStr(1, „abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ -_äöüÄÖÜß0123456789“, Mid(myText, Pos, 1)) 0 Then
makeSaveName = makeSaveName & Mid(myText, Pos, 1)
End If
Next Pos
End Function
LikeLike
Nachtrag: Ich glaube ich habe zumindest einen erstenm Fehler gefunden. Die Anführungszeichen werden falsch rüber kopiert, und das bekommt der Editor nicht gebacken. Eins unten und eins oben mag er nicht.
Allerdinngs bekomme ich jetzt als meldung „Erwartet: Then oder Goto“ nei der 0, da wo eigentlich ein Then steht.
LikeLike
Nochmal ich.
Ich habe die 0 jetzt entfernt, nun läuft es. anscheinend richtig.
Danke für Deine Hilfe
LikeLike
Schnelles Copy-Paste, sorry, my bad.
Ja, die Anführungszeichen müssen immer “ sein, nicht so wie in meinem ersten Wurf.
Und es fehlt was (wo auch immer ich das verloren habe):
If InStr(1, „abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ -_äöüÄÖÜß0123456789“, Mid(myText, Pos, 1)) = 0 Then
LikeLike
Hallo,
ich habe leider absolut keinen Erfolg mit den Skript. Es wird nicht eine PDF in den Ordner abgelegt.
„Mein“ Skript:
Public Sub Anhaenge_handeln(myItem As Outlook.MailItem)
Dim mAtts As Attachments
Dim mAtt As Attachment
Set mAtts = myItem.Attachments
While mAtts.Count > 0
Set mAtt = mAtts(1)
mAtt.SaveAsFile „C:\Users\ELW-Lohne\Documents\outlook-attachments\“ & mAtt.DisplayName
mAtts.Remove 1
Wend
End Sub
Bitte hilf mir!
LikeLike
Wie wird denn die Prozedur gestartet?
Was passiert dann? Gar nichts?
LikeLike
Hallo Katharina,
erstmal vielen Dank für diese simple aber total effektive Lösung, um Anhänge aus Mails automatisch abzulegen.
Wir benutzen für die Ablage der per Mail übersendeten Rechnungen dieses VBA-Script….(habe ich mir aus Deinem Blog „zusammenkopiert“).
Leider gibt es Rechnungssteller, die im Dateinamen Sonderzeichen verwenden….z.B. backslash \ … Dadurch hält Dein VBA.Script im Debugg-Modus an, da es natürlich zurecht meint, dass Sonderzeichen in Dateinamen ungültig sind.
Hast Du eventuell eine Lösung, wie aus den Dateinamen die Sonderzeichen entfernt werden können?
Wir verwenden dieses angepasste VBA-Script:
Public Sub Anhaenge_handeln(myItem As Outlook.MailItem)
Dim numAtt As Long
numAtt = 1
Set mAtts = myItem.Attachments
While mAtts.Count > numAtt – 1
Set mAtt = mAtts(numAtt)
If LCase(Right(mAtt.DisplayName, 4)) = „.pdf“ Then
mAtt.SaveAsFile „\\Firma\fileserver\Ordner\Rechnungseingang PDF\“ & Format(myItem.ReceivedTime, „yyyymmdd“) & „_“ & mAtt.DisplayName
mAtt.Delete
Else
numAtt = numAtt + 1
End If
Wend
End Sub
Danke und Grüße
Axel
LikeLike
Hallo Axel,
sorry für die späte Antwort – das Leben hat mich ganz schön beschäftigt in der jüngsten Zeit.
Du brauchst:
Public Function makeSaveName(myText As Variant) As Variant
Dim Pos As Long
Dim Chars As Variant
For Pos = 1 To Len(myText)
If InStr(1, „abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ -_äöüÄÖÜß0123456789“, Mid(myText, Pos, 1)) 0 Then
makeSaveName = makeSaveName & Mid(myText, Pos, 1)
End If
Next Pos
End Function
und dann eine Änderung der einen Zeile in
mAtt.SaveAsFile „\\Firma\fileserver\Ordner\Rechnungseingang PDF\“ & Format(myItem.ReceivedTime, „yyyymmdd“) & „_“ & makeSaveName(mAtt.DisplayName)
Damit werden alle Zeichen, die nicht in abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ -_äöüÄÖÜß0123456789 vorkommen, entfernt.
Herzliche Grüße
Katharina
LikeLike
Sehr geehrte Frau Schwarzer,
Hallo Katharina,
erstmal vielen DANK für Deine Internetseite, diese Kommentar/Beitragssammlung und Deinen Input. Toll! Kann mir ansatzweise vorstellen wieviel Arbeitsstunden Du durch Deine Codes Allen ersparst.
Auch ich habe eine Frage, ich verfolge seit einigen Stunden folgendes Ziel:
In Outlook soll mit Hilfe einer Regel eine Email
– als gelesen markiert werden (erledigt)
– in einen Outlook Unterordner verschoben werden (erledigt)
– ein VBA scrip ausgeführt werden welches:
a. Anhänge welche eine bestimmte Buchstabenreihenfolge enthalten
b. in einen von mir definierten Laufwerkordner verschiebt (ohne den/die Anhang/Anhänge in outlook zu löschen)
Ich versuche Deine unterschiedlichen Skripte hier zu kombinieren aber ich mache das sicher nicht richtig, da ich leider kein VBA Verständnis habe.
Könntest Du Dein ursprüngliche Skript aus September 2015 ggf. entsprechend ergänzen?
Public Sub Anhaenge_handeln(myItem As Outlook.MailItem)
Dim mAtts As Attachments
Dim mAtt As Attachment
Set mAtts = myItem.Attachments
While mAtts.Count > 0
Set mAtt = mAtts(1)
mAtt.SaveAsFile „C:\meinSpeicherort\“ & mAtt.DisplayName
mAtts.Remove 1
Wend
End Sub
Vielen herzlichen Dank für Deine Hilfe.
Viele Grüße
Fabian
LikeGefällt 1 Person
hallo Fabian, – ich habe mich vor Jahren auch hier inspirieren lassen. in den vergangenen Wochen habe ich mir jedoch vermehrt von ChatGPT bezüglich der VBA Codes helfen lassen. Am sichersten ist man, wenn man dabei das bisher funktionierende Script hochlädt und seine gewünschten Änderungen kundtut. Das hat meinen e-mail-verkehr nun erheblich optmiert. Jedoch stelle ich auch fest, dass-sobald es komplexer wird- auch dort das Wissen ausgeht oder gewünschte Bedingungen kurzerhand verschluckt werden. Deshalb bin ich kurzerhand wieder hier gelandet. Mein Ersuchen ist es, dass, -sobald eine mail nicht nur auschließlich an mich gesendet wurde- diese ebenfalls in den Ordner „Mehrfachempfänger“ zu verschieben. Jedoch wenn ausschließlich ICH unter „To“ zu finden bin diese dennoch nicht zu verschieben. Der BeepTon soll zudem bei verschobenen Mails nicht erklingen. Ich habe hier nun schon etliche Anläufe bei ChatGPT mit Zig-Nachbesserungen gestartet. Aber das hier bekommt er entgegen seiner Behauptung nicht hin. Grundlegend ist es zumeist so, dass man das Programm entweder nciht Debuggen kann oder man es in der ScriptListe der email regel nicht in der Auswahlliste stehen hat….. Ich denke dass das Script selbst gar nciht so weit daneben liegen sollte, – Vielleicht kann man mir hier weiterhelfen:
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
Dim olInbox As Outlook.MAPIFolder
Dim olItems As Outlook.Items
Dim olMail As Outlook.MailItem
Dim olRecipients As Outlook.Recipients
Dim olRecipient As Outlook.Recipient
Dim olDestFolder As Outlook.MAPIFolder
Dim EntryID As Variant
Dim i As Long, j As Long
Dim blnFound As Boolean
On Error Resume Next
Set olInbox = Application.Session.GetDefaultFolder(olFolderInbox)
Set olItems = olInbox.Items
Set olDestFolder = olInbox.Folders(„Mehrfachempfänger“)
For i = olItems.Count To 1 Step -1
If TypeOf olItems(i) Is MailItem Then
Set olMail = olItems(i)
Set olRecipients = olMail.Recipients
‚ Check if mail has multiple recipients
If olRecipients.Count > 1 Then
‚ Check if mail is not exclusively sent to me
blnFound = False
For j = 1 To olRecipients.Count
Set olRecipient = olRecipients.Item(j)
If olRecipient.Type = olTo Then
If LCase(olRecipient.Address) = LCase(Application.Session.CurrentUser.Address) Then
blnFound = True
Exit For
End If
End If
Next j
‚ Move mail to designated folder
If Not blnFound Then
olMail.Move olDestFolder
olMail.PlaySound = False
End If
End If
End If
Next i
Set olInbox = Nothing
Set olItems = Nothing
Set olMail = Nothing
Set olRecipients = Nothing
Set olRecipient = Nothing
Set olDestFolder = Nothing
End Sub
LikeLike