如何在Outlook中創建一個資料夾來整理包含特定聯絡人的郵件？

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

被雜亂的收件匣淹沒了嗎？在本教程中，我將介紹三種方法，用於在Outlook中整理包含特定聯絡人的郵件，以提高效率。

始終將包含某些聯絡人的郵件移動到已創建的資料夾

創建搜尋資料夾以自動整理特定聯絡人的郵件

使用VBA批量創建資料夾以整理所有郵件帳戶的郵件

始終將包含某些聯絡人的郵件移動到已創建的資料夾

1. 右鍵單擊您要為其創建資料夾以整理郵件的郵件帳戶，從右鍵菜單中選擇「新建資料夾」，並命名該資料夾。

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

2. 在您的收件匣或已發送郵件資料夾中，選擇任何一封包含特定電子郵件地址的郵件訊息，並將所有他/她的郵件移動到已創建的資料夾中。

3. 在「首頁」選項卡的「移動」組中，根據需要點擊「規則」>「始終移動來自：特定電子郵件地址的郵件」和/或「規則」>「始終移動至：特定電子郵件地址的郵件」。

4. 在彈出的「規則和通知」對話框中，指定您要將郵件移動到的資料夾，然後點擊「確定」。

5. 收件匣或已發送郵件資料夾中符合條件的郵件現在已移動到您剛剛創建的資料夾中。如果未來的郵件符合條件，它們也會直接進入該資料夾。

創建搜尋資料夾以自動整理特定聯絡人的郵件

如果您不想將郵件移動到資料夾，而只是想方便查看，您可以創建一個搜尋資料夾。這使您能夠跨多個資料夾查找符合指定條件的郵件，但保持它們在原始資料夾中。

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

注意：