Maintain name of removed attachments - how to?

[Viggo_L]

Hi forum,

I need a method to maintain the name of removed attachments. It will be very useful in, at least, 2 scenarios:

1) When replying to a mail sent with attachment (and where I do not want to reply to all with said attachment);

2) When archiving mails to a repository where attachments are first deleted (by macro).

So basically in situations where the connection between the content of the mail, which often concerns or involves the attachment, is broken. So when retracting an old mail where a certain version of a document is described, it will be impossible to identify which document it concerns.

Any good ideas to do this?

VBA? I am already using a script deleting attachments during archiving.

Thanks!

 

[Diane Poremsky]

You can add the file name to the body at the time you delete it.

The complete code is at Save and Delete Attachments from Outlook messages - Outlook Tips - this is the snippet you need - this one does the path to where it was saved. You can add just the filename.

   ' Adds the filename string to the message body and save it
   ' Check for HTML body
   If objMsg.BodyFormat <> olFormatHTML Then
       objMsg.Body = objMsg.Body & vbCrLf & _
       "The file(s) were saved to " & strDeletedFiles
   Else
       objMsg.HTMLBody = objMsg.HTMLBody & "<p>" & _
       "The file(s) were saved to " & strDeletedFiles & "</p>"
   End If
       objMsg.Save

 

[Viggo_L]

Many thanks for the quick response! It looks like the ting to use, but can it be added to the code I use for deleting attachments?

If so, where should it be inserted to save the names of each attachment for each individual mail before the deletion step is performed?

Below is the code I use for deletion:

--
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
myAttachments(1).Delete
lngAttachmentCount = myAttachments.Count
Wend

myItem.Save
Next

MsgBox "Done. All attachments were deleted.", vbOKOnly, "Message"

Set myAttachment = Nothing
Set myAttachments = Nothing
Set selItems = Nothing
Set myItem = Nothing

End Sub

You can add the file name to the body at the time you delete it.

The complete code is at Save and Delete Attachments from Outlook messages - Outlook Tips - this is the snippet you need - this one does the path to where it was saved. You can add just the filename.

   ' Adds the filename string to the message body and save it
   ' Check for HTML body
   If objMsg.BodyFormat <> olFormatHTML Then
       objMsg.Body = objMsg.Body & vbCrLf & _
       "The file(s) were saved to " & strDeletedFiles
   Else
       objMsg.HTMLBody = objMsg.HTMLBody & "<p>" & _
       "The file(s) were saved to " & strDeletedFiles & "</p>"
   End If
       objMsg.Save

 

[Diane Poremsky]

You are deleting but not saving, so you need to get the filenames as you delete.

My code counts the attachments and counts down rather than looping - so you may need to change your code to do that but try something like this first - (change the i to a 1 for your code)

strFile = myAttachments.Item(i).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

 

[Diane Poremsky]

Just tested it... you'll need to set strFile = "" - maybe after the save, before it moves to the next message.

 

[Viggo_L]

Diane, thanks a lot for the code and testing, much appreciated.

However, I can not get the code to run. I have made different attempts and it returns different error messages (such as: "Object required", "Compile error: Wend without While"). Maybe I am missing some crucial parts (I am not proficient enough to detect it myself...).

I have added the script into a module, is that correct?

So maybe a simpler method would help, namely to first run a script putting name/names of the attachment into the mail (not all mails have attachment).

After that I would run the macro to delete the attachments.

I dont know if it simplifies it or if it solves my problem running the code.

Could that solve my problem?

Viggo

 

[Diane Poremsky]

This is what I did - dropped those lines into your code.

Were you using the code before? If so, replace your code with this code. If not, paste it into a module. And make sure that macro security is low. More info at How to use Outlook's VBA Editor - Slipstick Systems

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

 

[Viggo_L]

Diane, it works beautifully! Apologize that I had to get so detailed out. This is gonna be very useful.

Thanx a lot!

 

[Tobermory]

Here's my version of the macro - I tweaked the text that appears in the email by adding the date and time, plus listing the deleted files as bullets. I also wrap all of the text in a box.

Additional question: is there a way to only delete actual attachments and not delete inline images? Currently, the macro does both.

David.

Sub Delete_attachments_nosave()
Dim Response As VbMsgBoxResult
Response = MsgBox("Do you want to delete all attachments in selected emails?", _
   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
strFilelistText = vbCrLf & "* " & myAttachments.Item(1).FileName & strFilelistText
strFilelistHTML = "<li style='margin:0px;'>" & myAttachments.Item(1).FileName & "</li>" & strFilelistHTML
myAttachments(1).Delete
lngAttachmentCount = myAttachments.count
Wend

If myItem.BodyFormat <> olFormatHTML Then
myItem.Body = "The following files were removed on " & Format(Now, "MM/dd/yyyy h:nn am/pm") & ":"& strFilelistText & vbCrLf & vbCrLf & myItem.Body
Else
myItem.HTMLBody = "<div style='border: black 1px solid; padding: 10px; margin: 0 0 10px 0; width: 300px; font-family:verdana, arial, helvetica, sans-serif; font-size:10px;'><p'><b>The following files were removed " & Format(Now, "MM/dd/yyyy h:nn am/pm") & ":</b></p><ul>" & strFilelistHTML & "</ul></div>" & myItem.HTMLBody
End If
myItem.Save
strFilelistText = ""
strFilelistHTML = ""
Next
MsgBox "Done. All attachments were deleted.", vbOKOnly, "Message"
Set myAttachment = Nothing
Set myAttachments = Nothing
Set selItems = Nothing
Set myItem = Nothing
End Sub

 

[Diane Poremsky]

Well, inline images are attachments... so, unless the attachment is huge and the inline images are small.. or the attachment is a specific file type, no. Basically, you need to use an if statement to check the attachment and see if you want to save/remove/whatever. Check for size or specific file types....

For file names check the last 4 characters - something like this, which checks the file type and if it's an image, checks the size (from this article).

' Get the file name.
strFile = objAttachments.Item(i).filename
' This code looks at the last 4 characters in a filename
sFileType = LCase$(Right$(strFile, 4))
Select Case sFileType
' Add additional file types below
Case ".jpg", ".png", ".gif"
If objAttachments.Item(i).Size < 5200 Then
GoTo next i
End If
End Select


this one only processes specific file types

If colAtts.Count Then
For Each oAtt In colAtts
' This code looks at the last 4 characters in a filename
sFileType = LCase$(right$(oAtt.FileName, 4))
Select Case sFileType
' Add additional file types below
Case ".xls", ".doc", "docx"
' do whatever
End Select
Next
End If