需求：开发Outlook宏实现按主题编号自动保存邮件至对应目录

步骤1：启用Outlook宏功能 #

Outlook默认禁用宏，先开启：

• 打开Outlook→文件→选项→信任中心→信任中心设置→宏设置→选择「启用所有宏（不推荐；可能会运行危险代码）」或者「启用签署的宏」（后续可给宏签名提升安全性）。

步骤2：打开VBA编辑器并创建模块 #

• 按下Alt+F11打开VBA编辑器；
• 在左侧「项目」面板右键点击ThisOutlookSession→插入→模块；
• 在空白代码窗口粘贴下方代码。

步骤3：宏代码实现 #

Sub SaveEmailBySubjectID()
    ' 声明变量
    Dim selItem As Object
    Dim mailItem As Outlook.MailItem
    Dim subjectID As String
    Dim saveRootPath As String
    Dim saveFullPath As String
    Dim regEx As Object
    
    ' 替换为你的根保存目录
    saveRootPath = "C:\Your\Target\Root\Folder\"
    
    ' 检查是否选中邮件
    If Application.ActiveExplorer.Selection.Count = 0 Then
        MsgBox "请先选中至少一封邮件！", vbExclamation
        Exit Sub
    End If
    
    ' 遍历选中的邮件（支持多选）
    For Each selItem In Application.ActiveExplorer.Selection
        If TypeName(selItem) = "MailItem" Then
            Set mailItem = selItem
            
            ' 初始化正则，匹配格式如03100-001-01的编号
            Set regEx = CreateObject("VBScript.RegExp")
            regEx.Pattern = "\d{5}-\d{3}-\d{2}" ' 可根据实际编号格式调整，比如\d+-\d+-\d+匹配任意数字段
            regEx.Global = False
            
            ' 提取主题中的编号
            If regEx.Test(mailItem.Subject) Then
                subjectID = regEx.Execute(mailItem.Subject)(0).Value
                
                ' 构建目标目录路径
                saveFullPath = saveRootPath & subjectID & "\"
                
                ' 目录不存在则创建
                If Dir(saveFullPath, vbDirectory) = "" Then
                    MkDir saveFullPath
                End If
                
                ' 保存邮件为.msg格式，文件名避免特殊字符和重复
                mailItem.SaveAs saveFullPath & Replace(mailItem.Subject, ":", "-") & "_" & Format(Now(), "YYYYMMDDHHMMSS") & ".msg", olMSG
                MsgBox "邮件已保存至：" & saveFullPath, vbInformation
            Else
                MsgBox "该邮件主题未找到指定格式的编号！", vbExclamation
            End If
        End If
    Next selItem
    
    ' 释放对象
    Set mailItem = Nothing
    Set regEx = Nothing
    Set selItem = Nothing
End Sub

步骤4：适配你的实际需求 #

• 修改saveRootPath为你要使用的根目录；
• 调整正则表达式Pattern匹配你的编号格式：比如编号是XXX-XX-XXX就改成\d{3}-\d{2}-\d{3}；
• 如需保存为.eml格式，将olMSG替换为olEML。

步骤5：快速触发宏 #

• 回到Outlook，右键点击快速访问栏→自定义快速访问工具栏；
• 在「从下列位置选择命令」中选「宏」，找到SaveEmailBySubjectID添加到右侧，还可设置专属图标。

注意事项 #

• 确保目标目录有读写权限，否则会创建失败；
• 宏仅对选中的邮件生效，未选中时会弹出提示；
• 定期备份VBA模块代码，避免Outlook更新丢失。

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