Bekommen Sie häufig Nachrichten mit Anhängen? Wenn Sie viele Nachrichten bekommen kann dies zu einem Problem führen, da Outlook alle Daten in der *.pst speichert. Diese *.pst hat nur eine begrenzte Kapazität, deshalb sollten Sie möglichst versuchen die Größe Ihrer Nachrichten klein zu halten. Das funktioniert am einfachsten wenn Sie alle Anhänge aus den Nachrichten entfernen. Wir zeigen Ihnen wie Sie mit einem VBA Code die Anhänge sichern und aus den Nachrichten entfernen können.
Als erstes müssen Sie den unten stehenden VBA Code markierenund kopieren:
Sub AnhaengeSpeichern()
'Festlegen der Parameter
Dim myOrt As String
Dim myOlApp As New Outlook.Application
Dim myOlExp As Outlook.Explorer
Dim myOlSel As Outlook.Selection
Dim myteils, myteil, myAnhänge, myAnhang As Object
'Hier wird nach dem Ort gefragt wo gespeichert werden soll, _
wenn Sie den Pfad ändern. Muss dieser vorher schon erstellt sein
myOrt = InputBox("Speicherort", "Anhänge Speichern unter: ", "C:")
On Error Resume Next
'arbeitet die einzelnen Nachrichten ab
Set myOlExp = myOlApp.ActiveExplorer
Set myOlSel = myOlExp.Selection
'für alle Teile...
For Each myteil In myOlSel
'Anhänge festlegen
Set myAnhänge = myteil.Attachments
'wenn welche dar sind, dann
If myAnhänge.Count > 0 Then
'fügt einen Hinweis in die Email ein
myteil.Body = myteil.Body & vbCrLf & _
"Entfernte Anhänge:" & vbCrLf
'und für alle Anhänge...
For i = 1 To myAnhänge.Count
'nun werden Sie am Speicherort abgelegt
myAnhänge(i).SaveAsFile myOrt & _
myAnhänge(i).DisplayName
'hier wird Name und der Ort in der Nachricht eingetragen
myteil.Body = myteil.Body & _
"Datei: " & myOrt & _
myAnhänge(i).DisplayName & vbCrLf
Next i
'für alle Anhänge...
While myAnhänge.Count > 0
'entferne es (wird für Outlook 2002/2003 benötigt)
'myAnhänge.Remove 1
'entferne es (wird für Outlook 2000 benötigt)
myAnhänge(1).Delete
Wend
'abspeichern ohne Anhang
myteil.Save
End If
Next
'free variables
Set myteils = Nothing
Set myteil = Nothing
Set myAnhänge = Nothing
Set myAnhang = Nothing
Set myOlApp = Nothing
Set myOlExp = Nothing
Set myOlSel = Nothing
Resume
End Sub
Gehen Sie nun in Outlook in das Menü Extras/Makros/Visual Basic-Editor.
Sie sind nun im VBA Editor von Outlook um den kopierten einzufügen, gehen Sie im Menü auf Einfügen/Modul. Dort wo jetzt der Cursor blinkt (STRG + V), fügen Sie den VBA Code (von oben) ein! Anschließend klicken Sie auf Speichern (STRG + S).
Jetzt können Sie den Visual Basic-Editor wieder schließen (ALT + Q).
Um das Skript zu testen, markieren Sie eine Nachricht mit einem Anhang (auswählen). Gehen Sie nun in das Outlook Menü Extras/Makro/Makros (ALT + F8) und hier wählen Sie das Makro AnhaengeSpeichern aus und klicken Sie dann auf Ausführen.
Nun erscheint folgendes Fenster:
Geben Sie hier bitte den Pfad in dem Sie die Anhänge ablegen möchten.
Achtung: Dieser muss aber vorher erstellt worden sein, z.B. im Windows Explorer. Sonst werden die Anhänge gelöscht.
Wenn Sie einen immer den selben Pfad versenden möchten, können Sie das VBA Skript auch selber anpassen.
Gehen Sie im Visual Basic-Editor in folgende Zeile:
myOrt = InputBox(„Speicherort“, „Anhänge Speichern unter: „, „C:IHR PFAD„)
Hier können Sie die Pfadangaben anpassen.
Je nach Sicherheitseinstellung kann es vorkommen dass Sie diese Nachricht erhalten:
Setzen Sie das Häkchen bei Zugriff gewähren…. und bestätigen Sie mit Ja.
Es werden alle Anhänge in das gewünschte Verzeichnis geschoben. Wenn Sie sich nun die Nachricht ansehen, steht jetzt in der Nachricht wo der Anhang abgelegt wurde.
Das sieht dann z.B. so aus:
Entfernte Anhänge:
Datei: C:capricious.gif
Wenn Sie mehrere Nachrichten markieren können Sie schnell alle Anhänge mit diesem Marko aus Outlook entfernen.
Besuchen Sie auch unser Outlook VBA Forum:
https://www.mailhilfe.de/forum/bereich-neu12-html/bereich-neu72.html
Wenn Ihnen die Funktionen dieses Outlook VBA Codes nicht ausreichen, sollten Sie das Outlook Addon Attachments Processor testen.
Danke für den super praktischen Code!
Funktioniert das heutzutage immer noch mit den neueren Versionen von Outlook? Und gibt es eine Möglichkeit, dass automatisch ein Verweis in den Mailtext eingefügt wird, wohin die Mail gespeichert wurde?
‚Für Datum und Zeit bei Anhängen kann man diesen Code Verwenden.
Sub AnhaengeSpeichern()
‚Festlegen der Parameter
Dim myOrt As String
Dim myOlApp As New Outlook.Application
Dim myOlExp As Outlook.Explorer
Dim myOlSel As Outlook.Selection
Dim myteils, myteil, myAnhänge, myAnhang As Object
Dim myDate As String
myDate = Year(Date) & Month(Date) & Day(Date)
myDate = myDate & Hour(Time) & Minute(Time) & Second(Time)
‚Hier wird nach dem Ort gefragt wo gespeichert werden soll, wenn Sie den Pfad ändern. Muss dieser vorher schon erstellt sein
myOrt = InputBox("Speicherort", "Anhänge Speichern unter: ", "C:\")
On Error Resume Next
‚arbeitet die einzelnen Nachrichten ab
Set myOlExp = myOlApp.ActiveExplorer
Set myOlSel = myOlExp.Selection
‚für alle Teile…
For Each myteil In myOlSel
‚Anhänge festlegen
Set myAnhänge = myteil.Attachments
‚wenn welche dar sind, dann
If myAnhänge.Count > 0 Then
‚fügt einen Hinweis in die Email ein
myteil.Body = myteil.Body & vbCrLf & "Entfernte Anhänge:" & vbCrLf
‚und für alle Anhänge…
For i = 1 To myAnhänge.Count
’nun werden Sie am Speicherort abgelegt
myAnhänge(i).SaveAsFile myOrt & myDate & myAnhänge(i).DisplayName
‚hier wird Name und der Ort in der Nachricht eingetragen
myteil.Body = myteil.Body & "Datei: " & myOrt & myDate & myAnhänge(i).DisplayName & vbCrLf
Next i
‚für alle Anhänge…
While myAnhänge.Count > 0
‚entferne es (wird für Outlook 2002/2003 benötigt)
‚myAnhänge.Remove 1
‚entferne es (wird für Outlook 2000 benötigt)
myAnhänge(1).Delete
Wend
‚abspeichern ohne Anhang
myteil.Save
End If
Next
‚free variables
Set myteils = Nothing
Set myteil = Nothing
Set myAnhänge = Nothing
Set myAnhang = Nothing
Set myOlApp = Nothing
Set myOlExp = Nothing
Set myOlSel = Nothing
Resume
End Sub