Es kommt immer wieder von das Anhänge von Emails nicht mehr benötigt werden. Die E-Mail aber nicht gelöscht werden soll. Die Anhänge lassen sich aber nur bei geöffneter E-Mail löschen. Daher dieses kleine VBA-Script.
VBA-Code
Public Sub DeleteSelectedMailItemsAttachment()
Dim objFolder As MAPIFolder
Dim objMailSel As MailItem
Dim objSelection As Selection
Dim myattachments As Attachment
Dim i%, j%
'On Error Resume Next
'geht leider nur mit einer Mail
Select Case Application.ActiveWindow.Class
Case olExplorer
Set objFolder = Application.ActiveExplorer.CurrentFolder
If objFolder.DefaultMessageClass = "IPM.Note" Then
Set objSelection = Application.ActiveExplorer.Selection
If objSelection.Count = 0 Then
'MsgBox "Es sind keine Mails ausgewählt !"
Else
For Each objMailSel In objSelection
DoEvents
i = objMailSel.Attachments.Count
While i > 0
objMailSel.Attachments.Remove i
DoEvents
i = i - 1
Wend
Next
End If
Set objSelection = Nothing
Else
'MsgBox "Im Ordner '" & objFolder.Name & "' sind keine Mails enthalten!"
End If
Set objFolder = Nothing
Case olInspector
With Application.ActiveInspector
If .CurrentItem.Class = olMail Then
Set objMailSel = .CurrentItem
i = objMailSel.Attachments.Count
While i > 0
objMailSel.Attachments.Remove i
i = i - 1
Wend
Set objMailSel = Nothing
Else
'MsgBox "Es ist keine Mail aktiv !"
End If
End With
Case Else
End Select
End Sub