Outlook带原附件回复邮件时删除冗余图片的代码修改请求

要过滤掉命名为image+数字+.png/.Jpg的签名图片，只需在遍历原邮件附件的循环中添加判断逻辑，匹配该命名规则的附件直接跳过，不添加到回复邮件中。

修改核心点 #

在AddOriginalAttachments过程的附件遍历循环里，增加文件名判断：将文件名转为小写后，检查是否符合image*.png或image*.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
        Dim lowerFileName As String
        lowerFileName = LCase(Attachment.FileName)
        
        ' 跳过符合image+数字+.png/.jpg格式的签名图片
        If lowerFileName Like "image*.png" Or lowerFileName Like "image*.jpg" Then
            GoTo NextAttachment ' 跳过当前附件，进入下一次循环
        End If
        
        strFile = strPath & Attachment.FileName
        Attachment.SaveAsFile strFile
        MyAttachments.Add strFile, , , Attachment.DisplayName
        fso.DeleteFile strFile
        
NextAttachment:
    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

说明 #

• 使用LCase将文件名转为小写，避免因后缀大小写（如.Jpg）导致的判断遗漏
• 通过Like运算符匹配image*.png和image*.jpg模式，精准过滤目标冗余图片
• 用GoTo NextAttachment跳过符合条件的附件，不执行后续的保存和添加操作

内容的提问来源于stack exchange，提问作者Waleed