Office 365 Outlook VBA：修改代码将PDF附件以邮件主题命名

原修改后的代码存在三个核心问题：

• 路径拼接错误：saveFolder & "" & itm.Subject & ".PDF" 中缺少路径分隔符\，导致保存路径非法，文件无法正常写入，出现0KB空文件。
• 未过滤PDF附件：所有类型的附件都会被强制保存为PDF格式，非PDF附件内容无法被正确解析，同时也不符合"仅保存PDF附件"的需求。
• 未处理主题中的非法字符：邮件主题若包含Windows文件名禁止的字符（如/:*?"<>|），会导致保存失败。

修正后的代码 #

Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
    Dim objAtt As Outlook.Attachment
    Dim saveFolder As String
    Dim validSubject As String
    Dim attachCount As Integer
    
    saveFolder = "C:\Users\ppp\Desktop\Image Test"
    ' 替换邮件主题中的非法文件名字符
    validSubject = Replace(Replace(Replace(Replace(Replace(Replace(itm.Subject, "/", "-"), "\", "-"), ":", "-"), "*", "-"), "?", "-"), """", "-")
    validSubject = Replace(Replace(Replace(validSubject, "<", "-"), ">", "-"), "|", "-")
    validSubject = Trim(validSubject)
    attachCount = 1
    
    For Each objAtt In itm.Attachments
        ' 仅处理PDF格式附件（不区分大小写）
        If LCase(Right(objAtt.FileName, 4)) = ".pdf" Then
            Dim savePath As String
            ' 若存在多个PDF附件，添加序号避免覆盖
            savePath = saveFolder & "\" & validSubject & IIf(attachCount > 1, "(" & attachCount & ")", "") & ".pdf"
            objAtt.SaveAsFile savePath
            attachCount = attachCount + 1
        End If
        Set objAtt = Nothing
    Next
End Sub

关键修正点说明 #

• 路径合法性：添加路径分隔符\，确保保存路径格式正确。
• PDF过滤：通过LCase(Right(objAtt.FileName, 4)) = ".pdf"判断附件是否为PDF，不区分大小写。
• 非法字符处理：替换主题中所有Windows文件名禁止的字符为-，避免保存失败。
• 多附件防覆盖：当邮件包含多个PDF附件时，在主题后添加序号（如"主题(1).pdf"），防止文件被覆盖。

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