Delete extra redundant Images when using a code to reply to an email with the original attachments

Question

As you know while you are using outlook and reply to an email message, the original attachments is not included on the replied message.
So, I have used the below code and it works correctly, except it adds sometimes extra redundant Images to the new message.
I found that these images have the same name pattern , image & number & .png or Jpg ,like image001.png , image002.png , image003.Jpg , and so on.

These extra images is indeed the pictures of signature of other persons of the original email.

I need to amend the below code to delete these extra redundant Images

Sub ReplyAllWithAttachments()
    ReplyAndAttach (True)
End Sub
Function GetCurrentItem() As Object
    Dim objApp As Outlook.Application
 
    Set objApp = Application
  On Error Resume Next
    Select Case TypeName(objApp.ActiveWindow)
        Case "Explorer"
            Set GetCurrentItem = objApp.ActiveExplorer.Selection.Item(1)
        Case "Inspector"
            Set GetCurrentItem = objApp.ActiveInspector.CurrentItem
    End Select
 
    Set objApp = Nothing
End Function
 
Public Sub AddOriginalAttachments(ByVal MyItem As Object, ByVal myResponse As Object)
    Dim MyAttachments As Variant
    Set MyAttachments = myResponse.Attachments
 
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fldTemp = fso.GetSpecialFolder(2)  'User Temp Folder
    strPath = fldTemp.Path & "\"
 
    For Each Attachment In MyItem.Attachments
        strFile = strPath & Attachment.FileName
        Attachment.SaveAsFile strFile
        MyAttachments.Add strFile, , , Attachment.DisplayName
        fso.DeleteFile strFile
    Next
 
    Set fldTemp = Nothing
    Set fso = Nothing
    Set MyAttachments = Nothing
End Sub
 
Public Sub ReplyAndAttach(ByVal ReplyAll As Boolean)
    Dim MyItem As Outlook.MailItem
    Dim oReply As Outlook.MailItem
 
    Set MyItem = GetCurrentItem()
    If Not MyItem Is Nothing Then
 
        If ReplyAll = False Then
            Set oReply = MyItem.Reply
        Else
            Set oReply = MyItem.ReplyAll
        End If
 
        AddOriginalAttachments MyItem, oReply
        oReply.Display
        MyItem.UnRead = False
    End If
 
    Set oReply = Nothing
    Set MyItem = Nothing
End Sub

Does this answer your question? [Distinguish visible and invisible attachments with Outlook VBA](https://stackoverflow.com/questions/12310925/distinguish-visible-and-invisible-attachments-with-outlook-vba) — niton, Aug 03 '23 at 10:59
@niton , I found out that these extra images is indeed the pictures of signature of other persons of the original email — Waleed, Aug 03 '23 at 11:26
Not sure what to understand from your comment... Most probably that "extra images" are the pictures from the sender signature, I also found such pictures. But, did you solve your problem? — FaneDuru, Aug 03 '23 at 13:26
I think you can filter the attachment to reattach in `AddOriginalAttachments` against the respective pattern. I will try posting a small piece of code to replace an existing code slice. — FaneDuru, Aug 03 '23 at 13:33
You could try a different approach [Reply all with attachment](https://stackoverflow.com/questions/66152628/reply-all-with-attachment). `Set oFwdAttReplyAllTo = MyItem.Forward` and `oFwdAttReplyAllTo.To = MyItem.ReplyAll.To & ";" & MyItem.ReplyAll.CC`. — niton, Aug 03 '23 at 13:54

score 1 · Accepted Answer · answered Aug 03 '23 at 13:38

Please, try replacing this code part:

   For Each Attachment In MyItem.Attachments
        strFile = strPath & Attachment.FileName
        Attachment.SaveAsFile strFile
        MyAttachments.Add strFile, , , Attachment.DisplayName
        fso.DeleteFile strFile
    Next

with this slightly modified one:

   For Each Attachment In MyItem.Attachments
     If Not Attachment.FileName Like "*image###.png" And _
           Not Attachment.FileName Like "*image###.jpg" Then
        strFile = strPath & Attachment.FileName
        Attachment.SaveAsFile strFile
        MyAttachments.Add strFile, , , Attachment.DisplayName
        fso.DeleteFile strFile
      End If
   Next

Not tested, of course, but I think it should solve the problem. Not allowing to existing attachment named as that specific pattern to be processed in the existing way (save and reattach to the replay message).

I tried and it works as it should – Waleed Aug 03 '23 at 13:56 — Waleed, Aug 03 '23 at 13:56

Delete extra redundant Images when using a code to reply to an email with the original attachments

1 Answers1