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
Set objOL = CreateObject("Outlook.Application")
Set objSelection = objOL.ActiveExplorer.Selection
strFolderpath = "c:\Users\eugen\downloads\" & Format(Date, "dd.mm.yyyy") & "_"
For Each objMsg In objSelection
Set FSO = CreateObject("Scripting.FileSystemObject")
If LCase(FSO.GetExtensionName(strFile)) = "pdf" Then objAttachments.Item(i).SaveAsFile strFile
Set objAttachments = objMsg.Attachments
lngCount = objAttachments.count
If lngCount > 0 Then
For i = lngCount To 1 Step -1
strFile = objAttachments.Item(i).FileName
strFile = strFolderpath & strFile
objAttachments.Item(i).SaveAsFile strFile
Next i
End If
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