如何将Outlook邮件附件按单邮件分别提取到对应子文件夹？

你原有代码存在参数拼写错误：过程定义的入参是item，遍历附件时错误写成了itm，运行时会触发变量未定义报错，调整后的完整代码如下：

Public Sub saveAttachment(item As Outlook.MailItem)
    Dim attachment As Outlook.Attachment
    Dim defaultPath As String
    Dim folderName As String
    Dim fso As Object
    
    ' 配置默认根路径
    defaultPath = "c:\Email Exports"
    ' 创建文件系统对象（晚绑定，无需手动引用库）
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    ' 1. 处理邮件主题，过滤Windows文件名非法字符
    folderName = item.Subject
    ' 替换所有非法字符为下划线，可根据需求调整替换规则
    folderName = Replace(folderName, "/", "_")
    folderName = Replace(folderName, "\", "_")
    folderName = Replace(folderName, ":", "_")
    folderName = Replace(folderName, "*", "_")
    folderName = Replace(folderName, "?", "_")
    folderName = Replace(folderName, """", "_")
    folderName = Replace(folderName, "<", "_")
    folderName = Replace(folderName, ">", "_")
    folderName = Replace(folderName, "|", "_")
    
    ' 2. 拼接完整子文件夹路径
    Dim fullFolderPath As String
    fullFolderPath = fso.BuildPath(defaultPath, folderName)
    
    ' 3. 文件夹不存在则自动创建
    If Not fso.FolderExists(fullFolderPath) Then
        fso.CreateFolder fullFolderPath
    End If
    
    ' 4. 保存所有附件到对应子文件夹
    For Each attachment In item.Attachments
        attachment.SaveAsFile fso.BuildPath(fullFolderPath, attachment.DisplayName)
        Set attachment = Nothing
    Next
    
    ' 释放对象
    Set fso = Nothing
End Sub

关键逻辑说明 #

• 非法字符过滤：Windows系统不允许文件夹名包含/\<>:"|?*这9类字符，代码中统一替换为下划线，避免创建文件夹失败
• 路径拼接使用BuildPath方法，自动处理路径分隔符，避免手动拼接多写/少写反斜杠的问题
• 如果需要区分同主题的不同邮件，可以在文件夹名中补充收件时间字段，示例：folderName = Format(item.ReceivedTime, "yyyy-mm-dd hh-mm-ss") & "_" & folderName，已自动处理时间格式的非法字符问题。

内容的提问来源于stack exchange，提问作者Droid Rahl Carreon