我看你现在的问题是，用VBA保存邮件附件到Folder2时，遇到重名文件会直接覆盖，你尝试加编号的逻辑没生效对吧？咱们先说说你原来代码里的几个明显问题：

• 你写的If strFile <> strFile这个条件永远是假的，根本不会触发分支，这是核心逻辑错误；
• 你试图直接给objAttachments.Item(i)赋值（objAttachments.Item(i) = Replace(...)），但Attachment对象不能这么修改，应该先处理文件名字符串，再用处理后的路径保存。

下面是修正后的完整代码，包含邮件存PDF到Folder1、附件存Folder2且重名自动加编号（比如文件名.pdf→文件名_1.pdf→文件名_2.pdf）的功能：

Sub SaveEmailAsPDFAndAttachments()
    Dim objMail As Outlook.MailItem
    Dim strPDFPath As String
    Dim strAttachmentFolder As String
    Dim objAttachments As Outlook.Attachments
    Dim i As Integer
    Dim strFile As String
    Dim strFileName As String
    Dim strBaseName As String
    Dim strExtension As String
    Dim x As Integer
    
    ' 替换成你实际的文件夹路径
    strPDFPath = "C:\Folder1\"
    strAttachmentFolder = "C:\Folder2\"
    
    ' 自动创建不存在的目录，避免路径报错
    If Dir(strPDFPath, vbDirectory) = "" Then
        MkDir strPDFPath
    End If
    If Dir(strAttachmentFolder, vbDirectory) = "" Then
        MkDir strAttachmentFolder
    End If
    
    ' 遍历选中的邮件（如果只处理单封邮件，可直接指定objMail）
    For Each objMail In Application.ActiveExplorer.Selection
        ' 把邮件保存为PDF到Folder1
        objMail.SaveAs strPDFPath & Replace(objMail.Subject, " ", "_") & ".pdf", olPDF
        
        ' 处理当前邮件的所有附件
        Set objAttachments = objMail.Attachments
        If objAttachments.Count > 0 Then
            For i = 1 To objAttachments.Count
                ' 先把附件名称里的空格替换成下划线
                strFileName = Replace(objAttachments.Item(i).FileName, " ", "_")
                ' 拆分文件名和扩展名，方便后续加编号
                strBaseName = Left(strFileName, InStrRev(strFileName, ".") - 1)
                strExtension = Right(strFileName, Len(strFileName) - InStrRev(strFileName, "."))
                strFile = strAttachmentFolder & strFileName
                x = 1
                
                ' 循环检查文件是否存在，直到找到可用的新文件名
                Do While Dir(strFile) <> ""
                    strFile = strAttachmentFolder & strBaseName & "_" & x & "." & strExtension
                    x = x + 1
                Loop
                
                ' 用最终确定的路径保存附件
                objAttachments.Item(i).SaveAsFile strFile
            Next i
        End If
    Next objMail
    
    MsgBox "邮件和附件已保存完成！", vbInformation
End Sub

关键逻辑说明 #

• 自动创建目录：提前检查Folder1和Folder2是否存在，不存在就自动创建，避免因路径不存在导致的运行错误；
• 重名处理：用Do While循环不断生成带递增编号的文件名，直到找到一个不存在的文件路径，彻底解决覆盖问题；
• 文件名规范化：统一把邮件主题和附件名称里的空格替换成下划线，避免路径中出现空格引发的异常；
• 邮件转PDF：直接用Outlook内置的olPDF格式保存，比手动导出更稳定可靠。

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