A user wanted to know how to keep the name of an attachment in a message after using VBA to remove the attachment. Viggo_L 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 & "" & _ "The file(s) removed were: " & strFile & "
" 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 & "" & _
"The file(s) removed were: " & strFile & "
"
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
Run a script version
This version of the macro is used in a run a script rule. The conversion was simple: change the name of the macro to include myItem as outlook.mailitem inside the parenthesis and remove the lines that loop through with the selected messages.
Sub Delete_attachments_nosave(myItem As Outlook.MailItem)
Dim Response As VbMsgBoxResult
Response = MsgBox("Do you REALLY want to PERMANENTLY delete all attachments in the incoming messages?" _
, vbExclamation + vbDefaultButton2 + vbYesNo)
If Response = vbNo Then Exit Sub
Dim myAttachment As Attachment
Dim myAttachments As Attachments
Dim lngAttachmentCount As Long
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 & "" & _
"The file(s) removed were: " & strFile & "
"
End If
myItem.Save
strFile = ""
MsgBox "Done. All attachments were deleted.", vbOKOnly, "Message"
Set myAttachment = Nothing
Set myAttachments = Nothing
End Sub
Emily says
Can something like this be set up to run on sent items in a shared mailbox in Office 365?
Diane Poremsky says
if the mailbox is open in your profile, yes, You will need to use an itemadd macro and watch the folder.
Diane Poremsky says
you need to watch the folder - an example is here -
https://www.slipstick.com/outlook/archive-outlook/save-incoming-messages-hard-drive/
and to set the shared mailbox, you need this code
https://www.slipstick.com/developer/working-vba-nondefault-outlook-folders/#shared
The macro in the attached file should do it, but i did not test it. Change maryc to the mailbox alias.
Daniel says
Hi
I just tried out your script (to use as an outlook rule) and it not removing images that are included in the HTML body of an email and not as an attachment that outlook can see.
This is taking place on outlook 2016.
Do you know why this would happen?
Thank you :)
LyleB says
Diane,
I cooked up my own VBA code to do this awhile back, and just found your example - I wish I had found it earlier!
Anyway, when I substituted one chunk of your code into mine, the section that adds the list of what attacments were deleted, it changes the font of the message. Any idea why? Here's the pertinent section of my script (I can post the entire thing if needed)
' if it has deleted something, set the category & insert text into the bodyIf deletedSomething Then
obj.HTMLBody = strNewText & vbCrLf & obj.HTMLBody
obj.Categories = obj.Categories + "," + "Attachment Deleted"
Else
MsgBox ("No attachments to delete")
End If ' end if deletedSomething
Diane Poremsky says
maybe the p tag makes a difference?
myItem.HTMLBody = myItem.HTMLBody & "
" & _
"The file(s) removed were: " & strFile & "
"
End If
(That's my best guess without seeing your full code. )
Steve R says
THANKS !!!! This was a huge help!!! It's actually a work-around type thing, but I'll take it ! For years, I've been using macros in MSO to remove attachments and move them to a designated folder - I have been having a TON of problems doing this in v2013, WIN7 OS - when I try to run my macro, it freezes up. I didn't realize how easy it is to move attachments (just click and drag) to explorer - so I just move (copy) my attachments to the destination folder, and then run this macro - LOVE it !
Alice says
Hello,
I use this macro a lot. It does not seem to work in Outlook 2016. Is there a way to make it work? Thanks
Diane Poremsky says
It definitely should work. Step through the macro and see if it hits each line it should touch.
Jackie Dover says
HI Diane, I've run a VBA macro to save all the attachments in an Outlook folder and then delete the attachment from each e-mail. Is there a way to UN-delete all these attachments. The reason is that the macro did not copy attachments to the folder it was supposed to.
Diane Poremsky says
No, if the messages were saved, the attachments were deleted and they are gone. You could look in the securetemp folder - if you opened any recently, they might be there. It should be at shell:cache (type or paste that in the address bar of windows explorer) in a folder called Content.Outlook.
Dee says
Thanks very much! the script is really useful.
Dee says
Please help! How do I modify this so it becomes a selected script in an outlook rule?
i.e. when a message comes into the Inbox with x in body text and attachment, delete (don't save) the attachment?
Am at wits end with this one - thanks!
Diane Poremsky says
you need to add item as outlook.mailitem inside the () in the file name, or to make it easier for this macro, use myItem as outlook.mailitem. The remove the selection lines and Next at the end.
I added a run a script macro at the end of the article.
daniel says
Diane sorry bothering you
I am not expert at all in macros
I was trying several times but I cannot fix the error, for the case when I need to have the comments on the top.
Could you please advise or give the full macro.
Thanks,
Daniel
Diane Poremsky says
rearrange the body lines, like this:
If myItem.BodyFormat <> olFormatHTML Then
myItem.Body = "The file(s) removed were: " & strFile & _
vbCrLf & myItem.Body
Else
myItem.HTMLBody = "
" & _
"The file(s) removed were: " & strFile & "
" & _
myItem.HTMLBody
if you want it to be
The files were removed
original message
JohnK says
Diane, I tried your change but keep getting a "syntax error" when I try to run the script.
I deleted the following from the original script:
If myItem.BodyFormat olFormatHTML Then
myItem.Body = myItem.Body & vbCrLf & _
"The file(s) removed were: " & strFile
Else
myItem.HTMLBody = myItem.HTMLBody & "" & _
"The file(s) removed were: " & strFile & ""
End If
And replaced it with your suggested change:
If myItem.BodyFormat olFormatHTML Then
myItem.Body = "The file(s) removed were: " & strFile & vbcrlf & myItem.Body
Else
myItem.HTMLBody = & "
" & "The file(s) removed were: " & strFile & "
" & myItem.HTMLBody
End If
AND CANNOT get the script to run properly. There must be some type of error in the syntax of the change you suggested - or I am such a novice that I am just stumped. Any suggestions????
Diane Poremsky says
The error is likely here:
myItem.HTMLBody = & " " & "The file(s) removed were: " & strFile & " " & myItem.HTMLBody
that should all be one line.
JohnK says
Diane - you are a savior. I have been looking for a vba macro that would just Delete attachments from emails (not save them) and also insert the filename of the deleted attachment in the original email. Your code works perfectly in Outlook 2010.
Just one question, the code you provided inserts the filename of the deleted attachment at the bottom of the original email - I have tried (I am a real rookie in vba coding) but cannot tweak the code correctly to get the filename of the deleted attachment to insert at the TOP of the original email instead of the bottom.
What tweak is needed to place the filename at the top of the original email instead of the bottom? Any help you can provide will be greatly appreciated!
Diane Poremsky says
change the order of the string:
If myItem.BodyFormat <> olFormatHTML Then
myItem.Body = "The file(s) removed were: " & strFile & vbcrlf & myItem.Body
Else
myItem.HTMLBody = & "
" & "The file(s) removed were: " & strFile & "
" & myItem.HTMLBody
End If
JohnK says
Thanks so much for the quick reply! I really appreciate your help and assistance. Have a great rest of the week.
YossiD says
Though this thread is over five years old, I hope someone is still listening.
My VBA experience is very limited, and mostly in Word where I record macros then try to tweak them to work the way I want, often with help from forums.
For Outlook, I find this macro very useful since our mailbox sizes are quite limited and I get loads of emails with large attachments.
I'd like to modify this macro to add the following functionality (in order of importance)
1. Select which attachments to delete
2. Save deleted attachments to specified location
3. Record save location in the message
Any advice how to implement any or all of those?
Thanks
Diane Poremsky says
1. By extension or partial filename is do-able.
2. Will it always be the same location or will it vary by sender? Either is do-able. The link below has an example.
3. the macros at https://www.slipstick.com/developer/code-samples/save-and-delete-attachments/ show how to add the location to the message