Viggo_L wanted to know how to keep the name of an attachment in a message after using VBA to remove the attachment. He had the VBA code to remove the attachment but needed help saving the attachment name to the message.
Solution: add the attachment name to a string as you loop through the attachments and remove them:
While lngAttachmentCount > 0 strFile = myAttachments.Item(1).FileName & "; " & strFile
Then write the string to the bottom of the message:
If myItem.BodyFormat <> olFormatHTML Then myItem.Body = myItem.Body & vbCrLf & _ "The file(s) removed were: " & strFile Else myItem.HTMLBody = myItem.HTMLBody & "<p>" & _ "The file(s) removed were: " & strFile & "</p>" End If
Clear the string value before processing the next selected message:
myItem.Save strFile = "" Next
Delete attachments but save filenames to message
To use this code, you need to set macro security to Low. In Outlook 2010 or 2013, this is done in File, Options, Trust Center.
- Open the VB Editor using Alt+F11.
- Right click on Project1 and choose Insert > Module.
- Paste the code into the module.
- Select one or more messages and run the macro.
Tip: to test the macro, select some messages that have attachments and copy them to a new folder. Select all of the messages in the new folder, press Ctrl+C then Ctrl+V several time to make copies of the messages. Select some of the messages to test the macro. When you are satisfied it works as expected, delete the folder.
Sub Delete_attachments_nosave() Dim Response As VbMsgBoxResult Response = MsgBox("Do you REALLY want to PERMANENTLY delete all attachments in all SELECTED mails?" _ , vbExclamation + vbDefaultButton2 + vbYesNo) If Response = vbNo Then Exit Sub Dim myAttachment As Attachment Dim myAttachments As Attachments Dim selItems As Selection Dim myItem As Object Dim lngAttachmentCount As Long ' Set reference to the Selection. Set selItems = ActiveExplorer.Selection ' Loop though each item in the selection. For Each myItem In selItems Set myAttachments = myItem.Attachments lngAttachmentCount = myAttachments.count ' Loop through attachments until attachment count = 0. While lngAttachmentCount > 0 strFile = myAttachments.Item(1).FileName & "; " & strFile myAttachments(1).Delete lngAttachmentCount = myAttachments.count Wend If myItem.BodyFormat <> olFormatHTML Then myItem.Body = myItem.Body & vbCrLf & _ "The file(s) removed were: " & strFile Else myItem.HTMLBody = myItem.HTMLBody & "<p>" & _ "The file(s) removed were: " & strFile & "</p>" End If myItem.Save strFile = "" Next MsgBox "Done. All attachments were deleted.", vbOKOnly, "Message" Set myAttachment = Nothing Set myAttachments = Nothing Set selItems = Nothing Set myItem = Nothing End Sub