Outlook Anhänge aus Nachrichten entfernen und automatisch abspeichern.

Outlook

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:

Anhänge aus Nachrichten entfernen

 

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:

outlook vba

 

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.

-

Vorheriger Artikel Nächster Artikel

1 Stern2 Sterne3 Sterne4 Sterne5 Sterne (1 votes, average: 5,00 out of 5)
Loading...

2 Kommentare zu “Outlook Anhänge aus Nachrichten entfernen und automatisch abspeichern.

  1. David

    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?

    Antwort
  2. Anonymous

    ‘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
     

    Antwort

Schreibe einen Kommentar

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

CAPTCHA eingeben * Das Zeitlimit ist erschöpft. Bitte CAPTCHA neu laden.