如何在Outlook中创建按发件人移动邮件到对应文件夹的快捷操作

核心通过VBA自定义宏+快捷键绑定实现，原生Quick Action、分类规则无法满足动态识别发件人的需求，以下是具体操作步骤：

步骤1：开启Outlook开发者工具 #

• 打开Outlook，点击左上角「文件」→「选项」→「自定义功能区」，在右侧主选项卡列表中勾选「开发者」，确认后顶部导航栏将显示开发者选项卡。

步骤2：编写动态匹配发件人的VBA宏 #

• 点击开发者选项卡下的「Visual Basic」，或直接按Alt+F11打开VBA编辑器
• 在左侧项目管理器双击ThisOutlookSession，粘贴以下代码，需根据你的实际配置修改发件人邮箱、对应文件夹路径：

Sub MoveMailToSenderSpecificFolder()
    Dim objMail As Outlook.MailItem
    Dim objFolder As Outlook.MAPIFolder
    Dim senderAddress As String
    
    ' 仅处理当前选中的单封邮件
    If Application.ActiveExplorer.Selection.Count <> 1 Then Exit Sub
    If TypeName(Application.ActiveExplorer.Selection.Item(1)) <> "MailItem" Then Exit Sub
    Set objMail = Application.ActiveExplorer.Selection.Item(1)
    senderAddress = LCase(objMail.SenderEmailAddress)
    
    ' 发件人-文件夹映射配置，可按需增删条目
    Select Case senderAddress
        Case "friend1@any.com"
            ' 示例为收件箱下级的Friend1文件夹，路径可根据实际存储位置调整
            Set objFolder = Application.Session.GetDefaultFolder(olFolderInbox).Folders("Friend1")
        Case "friend2@any.com"
            Set objFolder = Application.Session.GetDefaultFolder(olFolderInbox).Folders("Friend2")
        Case Else
            MsgBox "未匹配到该发件人对应的专属文件夹", vbInformation
            Exit Sub
    End Select
    
    ' 执行移动操作
    If Not objFolder Is Nothing Then
        objMail.Move objFolder
    End If
End Sub

注意：如果专属文件夹存储在归档pst/其他服务器目录下，需调整代码中的文件夹定位逻辑即可

步骤3：绑定快捷键Ctrl+Shift+2 #

• 回到Outlook主界面，点击左上角「文件」→「选项」→「自定义功能区」，点击下方「键盘快捷方式：自定义」按钮
• 在「类别」列表找到「宏」，右侧「宏」列表选中刚编写的MoveMailToSenderSpecificFolder
• 点击「请按新快捷键」输入框，按下Ctrl+Shift+2，点击「指定」后保存设置即可使用

注意事项 #

• 首次使用需调整宏安全级别：开发者选项卡→「宏安全性」→选择「为所有宏提供通知」，重启Outlook后生效，仅需确认启用自己编写的宏即可，不会影响设备安全
• 只要你创建的专属文件夹是存储在Exchange/IMAP服务器上，移动操作会自动同步到所有登录账号的设备，不会出现仅本地生效的问题

内容的提问来源于stack exchange，提问作者Máté Izsóf