回复带有原始附件的电子邮件时删除多余的图像

Question

回复电子邮件时，回复消息中不包含原始附件。

下面的代码可以工作，只是它有时会在回复消息中添加额外的冗余图像。

我发现这些图像具有相同的名称模式， image & number & .png 或 Jpg ，如 image001.png 、 image002.png 、 image003.Jpg 等。

这些额外的图像是原始电子邮件中其他人签名的图片。

我需要修改代码来删除这些多余的冗余图像。

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

Answer 1

请尝试替换此代码部分：

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

稍微修改一下：

   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

当然没有经过测试，但我认为它应该可以解决问题。不允许以现有方式处理命名为该特定模式的现有附件（保存并重新附加到重播消息）。