Outlookで未読メールをお気に入りフォルダーに追加するにはどうすればよいですか？
未読のメールが多数のメッセージの中に残っている場合があります。Outlookでは未読メールの数（例：受信トレイ (5)）が表示されますが、すぐにそれを見つけることができません。実際には、すべての未読メールを一つのお気に入りフォルダーに集めることで、作業を便利かつ迅速に行うことができます。
次の手順では、すべての未読メールを「未読メール」フォルダーに収集し、そのフォルダーをお気に入りに表示する方法を説明します。
ステップ 1: ナビゲーションペインの「メール」 をクリックして、メールビューに切り替えます。
ステップ 2: 新しい検索フォルダーを作成します。
- Outlook 2010 / 2013では、フォルダタブの新規グループにある「新しい検索フォルダー」ボタンをクリックします。
- Outlook 2007では、「ファイル」→「新規」→「検索フォルダー」をクリックします。
新しい検索フォルダーを作成する別の方法もあります。ナビゲーションペインの「検索フォルダー」 を右クリックし、右クリックメニューから「新しい検索フォルダー」を選択します。
この方法は、Microsoft Outlook 2007、2010、および2013のすべてで使用できます。
ステップ 2: 「新しい検索フォルダー」ダイアログボックスで、「未読メール」アイテムを選択してハイライトし、「OK」をクリックします。
これで、「未読メール」フォルダーが作成され、ナビゲーションペインに表示されます。また、すべての未読メールがこのフォルダーに自動的に収集されます。未読メールが開かれた場合、それは「未読メール」フォルダーから自動的に削除されます。
ステップ 3: 「未読メール」フォルダーを右クリックし、右クリックメニューから「お気に入りに表示」を選択します。
これで、「未読メール」フォルダーがコピーされ、ナビゲーションペインの上部にあるお気に入りに追加されました。
ヒント: すべてのアカウントの未読メールを1つのフォルダーに追加したい場合は、以下の手順を実行してください。
1. Alt + F11キーを押して Microsoft Visual Basic for Applicationsウィンドウを有効にします。プロジェクトペインで「Microsoft Outlook Objects」→「ThisOoutlookSession」をクリックし、以下のコードを右側のセクションに貼り付けます。
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の1つまたは複数の連絡先フォルダから重複する連絡先をすべて削除する |
| 時々、同じ連絡先を何度も追加してしまうことがあります。その場合、1つまたは複数の連絡先フォルダから重複する連絡先をどのように削除すればよいでしょうか？Kutools for Outlookの「重複する連絡先」 機能を使用すると、すべての重複する連絡先を迅速に見つけ、指定された基準に基づいて重複する連絡先を削除したりマージしたりできます。たとえば、フルネームが同じ、または1つ以上の連絡先フォルダからメールアドレスが同じ連絡先を見つけられます。30日間の全機能無料体験版を今すぐお試しください！ |
 |
| Kutools for Outlook: 便利なOutlookアドインが数十種類含まれており、30日間は制限なく無料でお試しいただけます。 |
最高のオフィス生産性ツール
最新情報: Kutools for Outlook 無料版リリース！
新しくなった Kutools for Outlook を100以上の素晴らしい機能とともに体験してください！今すぐダウンロードしてみましょう！
🤖 Kutools AI : 高度なAI技術を活用し、メールの返信、要約、最適化、拡張、翻訳、作成までを簡単に処理します。
📧 メール自動化: 自動返信（POPとIMAPに対応） / スケジュール電子メールを送信 /送信時にルールで自動 CC/BCC / 高度なルールによる自動転送 / 挨拶を自動追加 / 複数宛先メールを自動的に一通ずつ分割...
📨 メール管理: メールの取り消し / 件名などで詐欺メールをブロックする / 重複メールを削除 / 高度な検索 / フォルダーを整理...
📁 添付ファイルプロ: 一括保存 / 一括切り離し / 一括圧縮 / 自動保存 / 自動的に切り離す / 自動圧縮...
🌟 インターフェイスマジック: 😊さらに美しくてクールな絵文字 /重要なメール到着時に通知 / Outlookを閉じるのではなくグループを最小化...
👍 ワンクリック便利機能: 全員に【Attachment】付きで返信 / フィッシング対策メール / 🕘送信者のタイムゾーン表示...
👩🏼🤝👩🏻 連絡先＆カレンダー: 選択したメールから一括で連絡先を追加 /連絡先グループを個別グループに分割 / 誕生日のリマインダーを削除...
お好みの言語で Kutools を利用可能 ― 英語、スペイン語、ドイツ語、フランス語、中国語など40以上の言語に対応！
Kutools for Outlookをワンクリックですぐに利用開始。待たずに今すぐダウンロードして効率を高めましょう！
🚀 ワンクリックダウンロード — Office用アドインをすべて入手
強くおすすめ: Kutools for Office（5-in-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