如何在Outlook中创建一个文件夹来整理包含特定联系人的邮件？

Author: Amanda Li Last Modified: 2025-05-07

被杂乱的收件箱压得喘不过气？在本教程中，我将介绍三种方法，帮助您在Outlook中整理包含特定联系人的邮件，从而提高效率。

始终将包含某些联系人的邮件移动到已创建的文件夹

创建搜索文件夹以自动整理特定联系人的邮件

使用VBA批量创建文件夹以整理所有邮箱账户的邮件

始终将包含某些联系人的邮件移动到已创建的文件夹

1. 右键单击要为其创建文件夹以整理邮件的邮箱账户，从右键菜单中选择“新建文件夹”，并为文件夹命名。

the steps of always moving emails containing certain people to a created folder

2. 在您的收件箱或已发送邮件文件夹中，选择任何一封包含特定电子邮件地址的邮件，这些邮件将全部移动到已创建的文件夹中。

3. 在“主页”选项卡的“移动”组中，根据需要点击“规则” > “始终从此人移动邮件：特定电子邮件地址”和/或“规则” > “始终移动邮件到：特定电子邮件地址”。

4. 在弹出的“规则和警报”对话框中，指定要将邮件移动到的文件夹，然后点击“确定”。

5. 收件箱或已发送邮件文件夹中符合条件的邮件现在已移动到您刚刚创建的文件夹中。未来符合条件的邮件也会直接进入该文件夹。

创建搜索文件夹以自动整理特定联系人的邮件

如果您不想将邮件移动到某个文件夹，而只是想轻松查看它们，可以在Outlook中创建一个搜索文件夹。这使您可以跨多个文件夹查找符合特定条件的邮件，同时保留它们在原始文件夹中的位置。

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

the steps of creating a search folder to automatically organize emails for specific people

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

注意：