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