Sub SaveAttachmentsFromSelectedItemsPDF()
Dim currentItem As Object
Dim currentAttachment As Attachment
Dim saveToFolder As String
Dim savedFileCountPDF As Long
Dim Foldername As String
saveToFolder = "c:\users\eugen\desktop\Mails"
savedFileCountPDF = 0
For Each currentItem In Application.ActiveExplorer.Selection
For Each currentAttachment In currentItem.Attachments
If UCase(Right(currentAttachment.DisplayName, 4)) = ".PDF" Then
currentAttachment.SaveAsFile saveToFolder & "\" & Format(Date, "dd.mm.yyyy") & "_" & _
Left(currentAttachment.DisplayName, Len(currentAttachment.DisplayName) - 4) & ".pdf"
savedFileCountPDF = savedFileCountPDF + 1
End If
Next currentAttachment
Next currentItem
MsgBox "Anlagen wurden gespeichert unter: ...\Desktop\Mails." & vbCr & "Anzahl der gespeicherten PDF: " & savedFileCountPDF, vbInformation
Foldername = "c:\users\eugen\desktop\Mails"
Shell "C:\WINDOWS\explorer.exe """ & Foldername & "", vbNormalFocus
End Sub