如何在 Outlook 中將未讀郵件添加到收藏夾文件夾？
Author: Kelly Last Modified: 2025-08-06
有時候未讀郵件可能會混雜在大量的郵件中，雖然 Outlook 會提示您未讀郵件的數量，例如收件匣 (5)，但您無法立即找到它們。實際上，您可以將所有未讀郵件收集到一個收藏夾文件夾中，讓您的工作更加方便快捷。
以下指導將幫助您將所有未讀郵件收集到一個名為「未讀郵件」的文件夾中，並將該文件夾顯示在您的收藏夾中。
步驟 1：通過點擊導航窗格中的「郵件」 切換到郵件檢視。
步驟 2：創建新的搜索文件夾：
- 在 Outlook 2010 / 2013 中，點擊「文件夾」標籤上的「新建搜索文件夾」按鈕（位於「新建」組中）。
- 在 Outlook 2007 中，點擊「文件」>「新增」>「搜索文件夾」。
實際上還有一種創建新搜索文件夾的替代方法：右鍵單擊導航窗格中的「搜索文件夾」 ，然後在右鍵菜單中點擊「新建搜索文件夾」。
此方法適用於 Microsoft Outlook 2007、2010 和 2013 的所有版本。
步驟 2：在「新建搜索文件夾」對話框中，選擇並高亮顯示「未讀郵件」項目，然後點擊「確定」。
現在已創建了一個「未讀郵件」文件夾，並顯示在導航窗格中。所有未讀郵件都會自動收集到這個文件夾中。一旦某封未讀郵件被打開，它將自動從「未讀郵件」文件夾中移除。
步驟 3：右鍵單擊「未讀郵件」文件夾，並在右鍵菜單中點擊「在收藏夾中顯示」選項。
現在，「未讀郵件」文件夾已被複製並添加到導航窗格頂部的收藏夾中。
提示：如果您想將所有帳戶的所有未讀郵件添加到一個文件夾中，可以按照以下步驟操作：
1. 按 Alt + F11 鍵啟用 Microsoft Visual Basic for Applications 窗口。在項目窗格中，點擊「Microsoft Outlook 物件」>「ThisOutlookSession」，並將以下代碼粘貼到右側部分。
Public WithEvents OlExplprer As Outlook.Explorer
Public WithEvents OlMailItem As Outlook.MailItem
Dim xSelMail As MailItem
Private Sub Application_NewMail()
AddAllAccountsUnreadMailsToAFolder
IniEvent
End Sub
Public Sub Initialize_handler()
Set OlExplprer = Application.ActiveExplorer
If OlExplprer.Selection.Count <> 0 Then
Set OlMailItem = OlExplprer.Selection.Item(1)
End If
End Sub
Private Sub OlExplprer_BeforeFolderSwitch(ByVal NewFolder As Object, Cancel As Boolean)
Dim xOlApp As Outlook.Application
Dim xNameSpace As NameSpace
Dim xMailItem, xSelMail As MailItem
Dim xTargetFld As Folder
On Error Resume Next
Set xOlApp = Outlook.Application
Set xNameSpace = xOlApp.GetNamespace("MAPI")
If NewFolder.Name = "Unread Mail" Then
For Each xMailItem In NewFolder.Items
If xMailItem.UnRead = False Then
xMailItem.Delete
End If
Next
Else
For Each xTargetFld In xNameSpace.Folders.Item(1).Folders
If xTargetFld.Name = "Unread Mail" Then
For Each xMailItem In xTargetFld.Items
If (OlExplprer.Selection.Count <> 0) Then
Set xSelMail = OlExplprer.Selection.Item(1)
If xSelMail.UnRead Then
xSelMail.UnRead = False
End If
End If
Next
End If
Next
End If
Cancel = False
End Sub
Private Sub OlExplprer_FolderSwitch()
Dim xOlApp As Outlook.Application
Dim xNameSpace As NameSpace
Dim xMailItem As MailItem
Dim xAccountFld, xTargetFld, xSubFolder As MAPIFolder
Dim xObjItem As Object
On Error Resume Next
Set xOlApp = Outlook.Application
Set xNameSpace = xOlApp.GetNamespace("MAPI")
Refresh
If (OlExplprer.CurrentFolder.Name <> "Unread Mail") Then
For Each xTargetFld In xNameSpace.Folders.Item(1).Folders
If xTargetFld.Name = "Unread Mail" Then
For Each xMailItem In xTargetFld.Items
If xMailItem.UnRead = False Then
For Each xAccountFld In xNameSpace.Folders
For Each xSubFolder In xAccountFld.Folders
If (xSubFolder.Name <> "Deleted Items") And (xSubFolder.Name <> "Drafts") And (xSubFolder.Name <> "Outbox") And (xSubFolder.Name <> "Junk E-mail") Then
For Each xObjItem In xSubFolder.Items
If xObjItem.Class = olMail Then
If (xObjItem.Subject = xMailItem.Subject) And (xObjItem.SenderName = xMailItem.SenderName) And _
(xObjItem.Body = xMailItem.Body) And (xObjItem.Attachments.Count = xMailItem.Attachments.Count) And _
(xObjItem.SentOn = xMailItem.SentOn) Then
xObjItem.UnRead = False
End If
End If
Next
End If
Next
Next
End If
Next
End If
Next
End If
End Sub
Private Sub OlExplprer_SelectionChange()
Dim xOlApp As Outlook.Application
Dim xNameSpace As NameSpace
On Error Resume Next
Set xOlApp = Outlook.Application
Set xNameSpace = xOlApp.GetNamespace("MAPI")
If (OlExplprer.CurrentFolder.Name = "Unread Mail") And (OlExplprer.Selection.Count <> 0) Then
SelUnreadMailFld OlExplprer.CurrentFolder.Items, xNameSpace.Folders
Else
If (OlExplprer.CurrentFolder.Name <> "Deleted Items") And (OlExplprer.CurrentFolder.Name <> "Drafts") And _
(OlExplprer.CurrentFolder.Name <> "Outbox") And (OlExplprer.CurrentFolder.Name <> "Junk E-mail") Then
SelOtherFld xNameSpace.Folders.Item(1).Folders
End If
End If
End Sub
Sub SelUnreadMailFld(EMails As Outlook.Items, Flds As Folders)
Dim xMailItem As MailItem
Dim xAccountFld, xSubFolder As Folder
Dim xObjItem As Object
On Error Resume Next
For Each xMailItem In EMails 'OlExplprer.CurrentFolder.Items
If xMailItem.UnRead = False Then
For Each xAccountFld In Flds
For Each xSubFolder In xAccountFld.Folders
If (xSubFolder.Name <> "Deleted Items") And (xSubFolder.Name <> "Drafts") And (xSubFolder.Name <> "Outbox") And (xSubFolder.Name <> "Junk E-mail") Then
For Each xObjItem In xSubFolder.Items
If xObjItem.Class = olMail Then
If (xObjItem.Subject = xMailItem.Subject) And (xObjItem.SenderName = xMailItem.SenderName) And _
(xObjItem.Body = xMailItem.Body) And (xObjItem.Attachments.Count = xMailItem.Attachments.Count) And _
(xObjItem.SentOn = xMailItem.SentOn) Then
If xObjItem.UnRead Then
xObjItem.UnRead = False
End If
End If
End If
Next
End If
Next
Next
End If
Next
End Sub
Sub SelOtherFld(Flds As Folders)
Dim xSelItem, xMailItem As MailItem
Dim xTargetFld As Folder
On Error Resume Next
If OlExplprer.Selection.Count <> 0 Then
Set xSelItem = OlExplprer.Selection.Item(1)
If xSelItem.UnRead = False Then
For Each xTargetFld In Flds
If xTargetFld.Name = "Unread Mail" Then
For Each xMailItem In xTargetFld.Items
If (xSelItem.Subject = xMailItem.Subject) And (xSelItem.SenderName = xMailItem.SenderName) And _
(xSelItem.Body = xMailItem.Body) And (xSelItem.Attachments.Count = xMailItem.Attachments.Count) And _
(xSelItem.SentOn = xMailItem.SentOn) Then
xMailItem.UnRead = False
End If
Next
End If
Next
End If
End If
End Sub
Sub Refresh()
Dim xOlApp As Outlook.Application
Dim xNameSpace As NameSpace
Dim xTargetFld As MAPIFolder
Dim xAllUnreadMails As Integer
On Error Resume Next
Set xOlApp = Outlook.Application
Set xNameSpace = xOlApp.GetNamespace("MAPI")
xAllUnreadMails = AllUnreadMails()
For Each xTargetFld In xNameSpace.Folders.Item(1).Folders
If xTargetFld.Name = "Unread Mail" Then
If xAllUnreadMails <> xTargetFld.Items.Count Then
AddAllAccountsUnreadMailsToAFolder
Exit For
End If
End If
Next
End Sub
Function AllUnreadMails()
Dim xOlApp As Outlook.Application
Dim xNameSpace As NameSpace
Dim xAllUnreadMails As Integer
On Error Resume Next
Set xOlApp = Outlook.Application
Set xNameSpace = xOlApp.GetNamespace("MAPI")
xAllUnreadMails = 0
For Each xFolders In xNameSpace.Folders
For Each xSubFolder In xFolders.Folders
If xSubFolder.Name <> "Unread Mail" Then
If (xSubFolder.Name <> "Deleted Items") And (xSubFolder.Name <> "Drafts") And (xSubFolder.Name <> "Outbox") And (xSubFolder.Name <> "Junk E-mail") Then
For Each xObjItem In xSubFolder.Items
If xObjItem.Class = olMail Then
If xObjItem.UnRead Then
xAllUnreadMails = xAllUnreadMails + 1
End If
End If
Next
End If
End If
Next
Next
AllUnreadMails = xAllUnreadMails
End Function
2. 接著插入一個新模組，並將以下代碼粘貼到模組腳本中。
Public Sub AddAllAccountsUnreadMailsToAFolder()
Dim xOlApp As Outlook.Application
Dim xNameSpace As NameSpace
Dim xFolders, xSubFolder As MAPIFolder
Dim xObjItem As Object
Dim xDelFld As Folder
Dim xUnreadMailFld, xOldUnreadMailFld As Folder
Dim xCopiedItem, xMailItem As MailItem
On Error Resume Next
Set xOlApp = Outlook.Application
Set xNameSpace = xOlApp.GetNamespace("MAPI")
For Each xOldUnreadMailFld In xNameSpace.Folders.Item(1).Folders
If xOldUnreadMailFld.Name = "Unread Mail" Then
xOldUnreadMailFld.Delete
Exit For
End If
Next
For Each xDelFld In xNameSpace.Folders.Item(1).Folders
If xDelFld.Name = "Deleted Items" Then
For Each xMailItem In xDelFld.Items
xMailItem.Delete
Next
For Each xSubFolder In xDelFld.Folders
'For i = xDelFld.Folders.Count To 1 Step -1
xSubFolder.Delete
Next
End If
Next
Set xUnreadMailFld = xNameSpace.Folders.Item(1).Folders.Add("Unread Mail")
If xUnreadMailFld = nil Then
Exit Sub
End If
For Each xFolders In xNameSpace.Folders
For Each xSubFolder In xFolders.Folders
If xSubFolder.Name <> xUnreadMailFld.Name Then
If (xSubFolder.Name <> "Deleted Items") And (xSubFolder.Name <> "Drafts") And (xSubFolder.Name <> "Outbox") And (xSubFolder.Name <> "Junk E-mail") Then
For Each xObjItem In xSubFolder.Items
If xObjItem.Class = olMail Then
If xObjItem.UnRead Then
Set xCopiedItem = xObjItem.Copy
xCopiedItem.Move xUnreadMailFld
End If
End If
Next
End If
End If
Next
Next
IniEvent
End Sub
Public Sub IniEvent()
Dim xFld As ThisOutlookSession
Set xFld = ThisOutlookSession
xFld.Initialize_handler
End Sub
3. 執行名為 AddAllAccountsUnreadMailsToAFolder 的代碼。然後，所有未讀郵件都被放入名為 「未讀郵件」 的文件夾中。
從Outlook的一個或多個聯絡人資料夾中刪除所有重複的聯絡人 |
| 有時我們可能會重複新增相同的聯絡人，該如何從一個或多個聯絡人資料夾中刪除重複的聯絡人呢？Kutools for Outlook 的 重複聯絡人 功能可以快速找到所有重複的聯絡人，並根據您提供的條件讓您刪除或合併重複的聯絡人，例如在相同全名、相同郵件地址的情況下，從一個或多個聯絡人資料夾中查找重複的聯絡人。點擊此處獲取 30-天全功能 30 免費試用！ |
 |
| Kutools for Outlook：包含數十種實用的Outlook增益工具，未來 30 天內免費試用且無任何限制。 |
最佳 Office 生產力工具
最新消息：Kutools for Outlook 推出免費版本！
體驗全新 Kutools for Outlook，擁有100+ 強大功能！立即下載！
🤖 Kutools AI ：運用先進 AI 技術，輕鬆處理郵件，包括答覆、摘要、優化、擴寫、翻譯與撰寫郵件。
📧 郵件自動化：自動回覆（支援 POP 和 IMAP） / 計劃發送郵件 / 發送郵件時根據規則自動抄送密送 / 自動轉發（高級規則） / 自動新增問候語 / 自動將多收件人郵件分割為個別郵件 ...
📨 郵件管理：撤回郵件 /依主題等條件阻擋詐騙郵件 / 刪除重複郵件 / 高級搜索 / 整合文件夾 ...
📁 附件專業版：批次保存 / 批次拆離 / 批次壓縮 / 自動保存 / 自動拆離 / 自動壓縮 ...
🌟 介面魔法：😊更多精美酷炫表情符號 /重要郵件來臨提醒 / 最小化 Outlook 而非關閉 ...
👍 一鍵神技：帶附件全部答復 /反釣魚郵件 / 🕘顯示發件人時區 ...
👩🏼🤝👩🏻 聯絡人與日曆：批次從選中郵件新增聯絡人 / 將聯絡人組分割為多個組 / 移除生日提醒 ...
以您偏好的語言使用 Kutools —— 支援英語、西班牙語、德語、法語、中文及40 多種其他語言！
只需一鍵即可立即啟用 Kutools for Outlook。立即下載，提升您的效率！
