Hallo zusammen. Ich habe ein gut funktionierendes Script zum Speichern von E-MAil Anlagen gefunden, dabei den Dateinamen mit vorangestelltem Datum erweitert, eine Ausgabe für den Benutzer hinzugefügt und lasse den entsprechenden Verzeichnisordner zur Kontrolle mit öffen. Soweit so gut, dann verlassen mich meine Kenntnisse :-(
Allerdings werden auch z.B. die Bilder aus den Signaturen der Mail mit gespeichert, was nicht sein sollte. Im Ansatz möchte ich per se nur PDF Anlagen speichern; weiß jemand Rat, wie sich das Script erweitern ließe?
Danke vorab für Eure Mühen.
Anbei das Script
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
Dim Foldername 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\eugen\downloads\" & Format(Date, "dd.mm.yyyy") & "_"
' 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
'Nur PDF Anhänge auswählen
Set FSO = CreateObject("Scripting.FileSystemObject")
If LCase(FSO.GetExtensionName(strFile)) = "pdf" Then objAttachments.Item(i).SaveAsFile strFile
' 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
'Benutzer benachrichtigen
MsgBox "Die Mail und alle Anhänge wurden gespeichert unter " & strFolderpath
Foldername = "c:\users\eugen\downloads"
Shell "C:\WINDOWS\explorer.exe """ & Foldername & "", vbNormalFocus
Next
ExitSub:
Set objAttachments = Nothing
Set objMsg = Nothing
Set objSelection = Nothing
Set objOL = Nothing
End Sub
Sub PrintAttachments()
End Sub
Sub Anlagenspeichern()
End Sub
|