如何在 Outlook 中创建文件夹，以便整理来自特定人员的邮件？

收件箱邮件太杂乱？本教程将为您介绍三种方法，助您在 Outlook 中高效整理来自特定人员的邮件。

始终将包含特定人员的邮件移动到新建文件夹

1. 右键点击您希望为其创建邮件整理文件夹的电子邮件账户，在弹出的菜单中选择“新建文件夹”，并为新文件夹命名。

2. 在收件箱或已发送邮件文件夹中，选择任意一封包含指定邮箱地址的邮件，准备将该邮箱地址的所有邮件移动到新建文件夹。

3. 在“主页”选项卡的“移动”组中，点击“规则”>“始终移动来自：特定邮箱地址的邮件”或“规则”>“始终移动发送给：特定邮箱地址的邮件”，根据需要进行选择。

4. 在弹出的“规则和警报”对话框中，选择您希望移动邮件的目标文件夹，然后点击“确定”。

5. 当前收件箱或已发送邮件文件夹中符合条件的邮件已成功移动至新建文件夹。今后，凡有新邮件符合条件，也将自动转入该文件夹。

创建搜索文件夹自动整理特定人员邮件

如果您不希望将邮件移动到其他文件夹，只需便捷地查看这些邮件，可以在 Outlook 中创建搜索文件夹。该功能让您能够跨多个文件夹查找符合特定条件的邮件，同时邮件仍然保留在原有文件夹中。

1. 在“文件夹”选项卡下的“新建类别”中，点击“新建搜索文件夹”。

2. 在弹出的新建搜索文件夹对话框，请按如下操作：

• 1) 在“选择搜索文件夹”窗口中，在“来自人员和列表的邮件”选项下，根据您的需求选择“收发自特定人员的邮件”或“来自特定人员的邮件”。
• 2) 在“自定义搜索文件夹”窗口中，点击“选择”，从您的地址列表中挑选联系人。
• 3) 指定需要搜索邮件的电子邮件账户。
• 4) 点击“确定”按钮。

3. 搜索文件夹已成功创建在搜索文件夹目录下，包含所有符合条件的邮件。

使用 VBA 批量为所有电子邮件帐户创建邮件分类文件夹

如果您在 Outlook 中拥有多个电子邮件帐户，并希望为每个帐户批量为特定联系人创建文件夹，可以通过 VBA 方法，将包含这些特定联系人的邮件从所有电子邮件帐户的收件箱或已发送邮件夹中批量移出。请按照以下步骤操作。

1. 在 Outlook 中，依次点击“文件”>“选项”>“信任中心”，然后选择“信任中心设置”。

2. 在弹出的对话框中，切换至“宏设置”选项，选择“启用所有宏”，并勾选“将宏安全设置应用于已安装的加载项”。

3. 点击“确定”按钮，关闭所有对话框。

4. 按下“Alt” + “F11”组合键，即可打开 Microsoft Visual Basic for Applications 窗口。

5. 点击“插入” > “模块”，然后将以下任一 VBA 代码粘贴到模块窗口中。

VBA 代码 1：批量在所有账户收件箱中为包含特定发件人的邮件创建文件夹

Sub MailArchiveSenderInInbox()
'Update by ExtendOffice
Dim I As Integer
Dim xAccount As Account
Dim xItem As Object
Dim xMail As MailItem
Dim xNewFolder As Folder
Dim xInboxFolder As Folder
Dim xSenderAddress As String
Dim xRecipient As Recipient
Dim xFolderName As String
xFolderName = "NewFolder" 'Replace "NewFolder" with desired folder name
Const PR_SMTP_ADDRESS = "http://schemas.microsoft.com/mapi/proptag/0x39FE001E"
On Error Resume Next
For Each xAccount In Application.Session.Accounts
  Set xInboxFolder = xAccount.DeliveryStore.GetDefaultFolder(olFolderInbox)
  Set xNewFolder = Nothing
  Set xNewFolder = xAccount.DeliveryStore.GetRootFolder.Folders(xFolderName)
  If xNewFolder Is Nothing Then
    Set xNewFolder = xAccount.DeliveryStore.GetRootFolder.Folders.Add(xFolderName)
  End If
  For I = xInboxFolder.Items.Count To 1 Step -1
    Set xItem = xInboxFolder.Items.Item(I)
    If xItem.Class = olMail Then
      Set xMail = xItem
      xSenderAddress = ""
      If xMail.Sender.Type = "EX" Then
        xSenderAddress = xMail.Sender.PropertyAccessor.GetProperty(PR_SMTP_ADDRESS)
      Else
        xSenderAddress = xMail.SenderEmailAddress
      End If
      If xSenderAddress = "" Then
        xSenderAddress = xMail.SenderEmailAddress
      End If
      If VBA.InStr(xSenderAddress, "name@example.com") <> 0 Then
        xMail.Move xNewFolder
      End If
    End If
  Next
  If xNewFolder.Items.Count = 0 Then
    xNewFolder.Delete
    xAccount.DeliveryStore.GetDefaultFolder(olFolderDeletedItems).Folders(xFolderName).Delete
  End If
Next
Set xInboxFolder = Nothing
Set xNewFolder = Nothing
End Sub

注意：请根据上述 VBA 代码中第 12 行、第 16 行及第 35 行的注释，更换相应的代码片段。

VBA 代码 2：批量在所有账户收件箱中为包含特定收件人的邮件创建文件夹

Sub MailArchiveRecipientInInbox()
'Update by ExtendOffice
Dim I As Integer
Dim xAccount As Account
Dim xItem As Object
Dim xMail As MailItem
Dim xNewFolder As Folder
Dim xInboxFolder As Folder
Dim xSenderAddress As String
Dim xRecipient As Recipient
Dim xFolderName As String
xFolderName = "NewFolder"
Const PR_SMTP_ADDRESS = "http://schemas.microsoft.com/mapi/proptag/0x39FE001E"
On Error Resume Next
For Each xAccount In Application.Session.Accounts
  Set xInboxFolder = xAccount.DeliveryStore.GetDefaultFolder(olFolderSentMail)
  Set xNewFolder = Nothing
  Set xNewFolder = xAccount.DeliveryStore.GetRootFolder.Folders(xFolderName)
  If xNewFolder Is Nothing Then
    Set xNewFolder = xAccount.DeliveryStore.GetRootFolder.Folders.Add(xFolderName)
  End If
  For I = xInboxFolder.Items.Count To 1 Step -1
    Set xItem = xInboxFolder.Items.Item(I)
    If xItem.Class = olMail Then
      Set xMail = xItem
      xSenderAddress = ""
      For Each xRecipient In xMail.Recipients
'        If xRecipient.Type = olCC Then
            xSenderAddress = xSenderAddress & ", " & xRecipient.PropertyAccessor.GetProperty(PR_SMTP_ADDRESS)
            If xSenderAddress = "" Then
              xSenderAddress = xSenderAddress & ", " & xRecipient.Address
            End If
'        End If
      Next
      If VBA.InStr(xSenderAddress, "name@example.com") <> 0 Then
        xMail.Move xNewFolder
      End If
    End If
  Next
  If xNewFolder.Items.Count = 0 Then
    xNewFolder.Delete
    xAccount.DeliveryStore.GetDefaultFolder(olFolderDeletedItems).Folders(xFolderName).Delete
  End If
Next
Set xInboxFolder = Nothing
Set xNewFolder = Nothing
End Sub

注意：

• 1) 您需要根据上述 VBA 代码中第 12 行、第 16 行和第 35 行的注释，替换相应的代码片段。
• 2) 如需归档包含特定抄送或密送收件人的邮件，请取消注释第 28 行和第 33 行，即删除这两行开头的单引号（‘）。

6. 按下“F5”运行 VBA 代码，如果有符合条件的邮件，将自动创建新文件夹。

相关文章

---

最佳办公效率工具

体验全新 Kutools for Outlook，畅享 100+ 强大功能！立即点击下载，不容错过！

🤖KUTOOLS AI：采用先进 AI 技术，轻松处理邮件，涵盖回复、摘要、优化、扩展、翻译及撰写等功能。

📧 邮件自动化：自动答复（支持 POP 和 IMAP）/定时发送邮件/发送邮件时按规则自动抄送密送/自动转发（高级规则）/自动添加称呼/自动将多收件人邮件拆分为单独信息……

📨 邮件管理：撤回邮件/按主题等条件拦截诈骗邮件/删除重复邮件/高级搜索/整合文件夹……

📁 附件增强：批量保存/批量分离/批量压缩/自动保存/自动拆离/自动压缩……

🌟 界面魔法：😊更多美观时尚表情/重要邮件到达时提醒您/最小化 Outlook 而不是直接关闭……

👍 一键精彩功能：带附件全部答复/反钓鱼邮件/🕘显示发送者当前时间时区……

👩🏼‍🤝‍👩🏻 联系人与日历：批量从选定邮件中提取添加联系人/将联系人组拆分为个人组/移除生日提醒……

在您的首选语言中畅享 Kutools —— 支持英语、西班牙语、德语、法语、中文等 40 多种语言！

一键解锁 Kutools for Outlook，告别等待，立即下载，让效率倍增！

Kutools for Outlook 功能列表      立即下载      前往购买

🚀 一键下载 — 即可获取全部 Office 加载项

强烈推荐：Kutools for Office（5 合 1）

一键下载五个安装包，即可同时获得 Kutools for Excel、Outlook、Word、PowerPoint 和 Office Tab Pro。立即点击下载！

• ✅ 一键便捷：只需一次操作，即可下载全部五个安装包。
• 🚀 轻松应对各类 Office 任务：随时按需安装所需插件，助您高效办公，不容错过！
• 🧰 包含：Kutools for Excel / Kutools for Outlook / Kutools for Word / Office Tab Pro / Kutools for PowerPoint

关于套件⬇ 下载套件💳 购买套件