Outlook で、不明な送信者からのメールを特定のフォルダーに自動的に移動するにはどうすればよいですか？

日常業務では、連絡先フォルダーに保存されていない不明な送信者から多数のメールが届くことがあります。こうしたメールは迷惑メールや悪意のあるものである可能性があるため、受信トレイではなく特定のフォルダーに自動的に移動させたい場合があります。Outlook でこの要望をどのように実現すればよいでしょうか？

ルールを作成して、不明な送信者からのメールを特定のフォルダーに移動する

VBA コードを適用して、不明な送信者からのメールを特定のフォルダーに移動する

---

ルールを作成して、不明な送信者からのメールを特定のフォルダーに移動する

実際にルールを作成すれば、不明な送信者からのメールを特定のフォルダーに自動で移動できます。以下の手順に従って設定してください。

1．受信トレイ内に、不明な送信者からのメールを格納するための新しいフォルダを作成します（下記スクリーンショット参照）。

2．次に、ホーム > ルール > ルールとアラートの管理をクリックします（スクリーンショット参照）。

3．ルールとアラートダイアログボックスで、メールルールタブの下にある新しいルールをクリックします（スクリーンショット参照）。

4．次に、OKボタンをクリックしてルールウィザードに進み、空白のルールから開始セクションのボックスから受信したメッセージにルールを適用するオプションを選択します（スクリーンショット参照）。

5．次に、次へボタンをクリックします。このステップでは、どのオプションも選択せず、そのまま次へボタンを直接クリックしてください。警告ボックスが表示されたら、はいボタンをクリックします（スクリーンショット参照）。

6．次のダイアログボックスで、ステップ1: アクションの選択リストボックス内の指定したフォルダーに移動するオプションをチェックし、その後、リンクテキスト指定したをクリックします。ルールとアラートダイアログが開いたら、メールを移動したいフォルダーを指定してください（スクリーンショット参照）。

7．OKボタンをクリックし、さらに次へボタンをクリックします。例外はありますか？ダイアログが表示されたら、ステップ1: 例外の選択リストボックス内で送信者が指定されたアドレス帳に含まれる場合を除くオプションをチェックし、その後、リンクテキスト指定されたをクリックします。すると、アドレスリストの追加ボックスが表示されるので、除外したい連絡先を含む連絡先フォルダーを選択してください（スクリーンショット参照）。

8．次に、追加ボタンをクリックし、その後次へをクリックして最後のウィザードダイアログに進みます。ステップ1: このルールの名前を指定するテキストボックスにルール名を入力し、ステップ2: ルールの設定オプションセクションにあるこのルールを有効にするオプションをチェックします（スクリーンショット参照）。

9．その後、完了およびOKボタンをクリックしてダイアログを閉じると、今後、不明な送信者からのメールが自動的に特定のフォルダーに移動されるようになります。

---

VBA コードを適用して、不明な送信者からのメールを特定のフォルダーに移動する

上記の方法が煩雑に感じられる場合は、より迅速に処理できるコードを適用することも可能です。

1．ALT + F11キーを押して、Microsoft Visual Basic for Applicationsウィンドウを開きます。

2．Microsoft Visual Basic for Applicationsウィンドウで、ThisOutlookSessionをProject1 (VbaProject.OTM)ペインからダブルクリックしてモジュールを開き、以下のコードを空のモジュールにコピー＆ペーストしてください。

VBA コード：不明な送信者からのメールを特定のフォルダーに自動移動する：

Public WithEvents MailItems As Outlook.Items
Private Sub Application_Startup()
    Set MailItems = Outlook.Application.Session.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub MailItems_ItemAdd(ByVal item As Object)
Dim xSenderEmailAddress As String
Dim xContactItems As Outlook.Items
Dim xContactItem As ContactItem
Dim I As Long
Dim xFilter As String
Dim xTargetFolder As Folder
Dim xContactFolder As Folder
Dim xStore As Store
Dim xInboxFlds As Folders
Dim xSubFolder As Folder
Dim xFound As Boolean
On Error Resume Next
If item.Class = olMail Then
    xSenderEmailAddress = item.SenderEmailAddress
End If
For Each xStore In Outlook.Application.Session.Stores
    Set xContactItems = xStore.GetDefaultFolder(olFolderContacts).Items
    For I = 3 To 1 Step -1
        xFilter = "[Email" & I & "Address] = " & xSenderEmailAddress
        Set xContactItem = xContactItems.Find(xFilter)
        If TypeName(xContactItem) <> "Nothing" Then Exit For
    Next
Next
If xContactItem Is Nothing Then
    Set xInboxFlds = Outlook.Application.Session.GetDefaultFolder(olFolderInbox).Folders
    xFound = False
    For Each xSubFolder In xInboxFlds
        If xSubFolder.Name = "Unknown" Then
            xFound = True
            Set xTargetFolder = Outlook.Application.Session.GetDefaultFolder(olFolderInbox).Folders("Unknown")
            Exit For
        End If
    Next
    If xFound = False Then
        Set xTargetFolder = Outlook.Application.Session.GetDefaultFolder(olFolderInbox).Folders.Add("Unknown")
    End If
    item.Move xTargetFolder
End If
End Sub

3．その後、コードを保存してコードウィンドウを閉じ、Outlook を再起動すると、コードが有効になります。これにより、今後、不明な送信者からのメールは自動的に「Unknown」フォルダーに移動されます（スクリーンショット参照）。

注：Unknownフォルダーは、不明なメールが届いた際に自動的に作成されます。スクリプト内のフォルダ名「Unknow」は、任意の名前に変更できます。