Outlook で重複を除き、2 つのフォルダーを1 つに統合するにはどうすればよいですか？

Outlook では、複数のメールアカウントや多数のフォルダーを利用している場合があります。特定のケースでは、2 つのフォルダーを1 つに統合し、重複するアイテムを削除したいと思うこともあるでしょう。この作業を迅速に完了するにはどうすればよいでしょうか？本記事では、Outlook でこの処理を可能な限りスピーディーに行うための VBA コードをご紹介します。

VBA コードで重複を除いて2 つのフォルダーを1 つに統合する

Kutools for Outlook で複数のフォルダーを統合し、重複アイテムを削除

---

VBA コードで重複を除いて2 つのフォルダーを1 つに統合する

2 つのフォルダーを1 つに統合し、重複アイテムを削除するには、以下の手順で VBA コードをご利用ください。

1。「Alt + F11」キーを押して、「Microsoft Visual Basic for Applications」ウィンドウを開きましょう。

2。左側のペインで「Project1」内の「ThisOutlookSession」をダブルクリックし、右側のスクリプトウィンドウに以下のコードをコピー＆ペーストしてください。

VBA：重複を除いて2 つのフォルダーを統合

Sub MergeOutlookFolders_WithoutDuplicates()
'UpdatebyExtendoffice20180521
Dim xSourceFolder As Outlook.Folder
Dim xTargetFolder As Outlook.Folder
Dim xCount, i As Long
Dim xItem As Object
Dim xSourceItem As Object
Dim xTargetItem As Object
Dim xDictionary As Scripting.Dictionary  'Object
Dim xStr As String
On Error Resume Next
Set xDictionary = New Scripting.Dictionary
Set xSourceFolder = Application.Session.PickFolder
Set xTargetFolder = Application.Session.PickFolder
xCount = 0
If xSourceFolder.DefaultItemType <> xTargetFolder.DefaultItemType Then
    MsgBox "Error: The two folders are not in same type!", vbExclamation + vbOKOnly, "Kutools for Outlook"
    Exit Sub
End If
For i = xSourceFolder.Items.Count To 1 Step -1
    Set xSourceItem = xSourceFolder.Items.Item(i)
    xSourceItem.Move xTargetFolder
Next
For i = xTargetFolder.Items.Count To 1 Step -1
    Set xTargetItem = xTargetFolder.Items.Item(i)
    Select Case xTargetItem.Class
        Case olMail
            With xTargetItem
                xStr = .Subject & .Body & .SentOn
            End With
        Case olAppointment
            With xTargetItem
                xStr = .Subject & .Start & .Duration & .Location & .Body
            End With
        Case olContact
            With xTargetItem
                xStr = .FullName & .Email1Address & .Email2Address & .Email3Address
            End With
        Case olTask
            With xTargetItem
                xStr = .Subject & .StartDate & .DueDate & .Body
            End With
    End Select
    If xDictionary.Exists(xStr) = True Then
        xTargetItem.Delete
        xCount = xCount + 1
    Else
        xDictionary.Add xStr, True
    End If
Next i
If xCount <> 0 Then
    MsgBox xCount & " duplicates removed when merging!", vbInformation + vbOKOnly, "Kutools for Outlook"
End If
End Sub

3。「ツール」＞「参照設定」をクリックし、表示されたダイアログで「Microsoft Scripting Runtime」のチェックボックスをオンにしてください。

4。「OK」をクリックし、「F5」キーを押してコードを実行します。すると、最初に統合したいフォルダーを選択するよう促すダイアログが表示されます（注：最初のフォルダー内のすべてのアイテムは、2 番目のフォルダーと統合された後に削除されます）。

5。「OK」をクリックします。2 回目に表示されるダイアログで、比較および統合の対象となる2 番目のフォルダーを選択してください。

6。「OK」をクリックすると、最初のフォルダー内のすべてのアイテムが2 番目のフォルダーに移動され、重複するアイテムは自動的に削除されます。

---

Kutools for Outlook で複数のフォルダーを統合し、重複アイテムを削除

VBA コードに不慣れな方は、「Kutools for Outlook」の便利なアドインをぜひお試しください。「フォルダの整理」と「重複したメール」のユーティリティを使えば、この作業を簡単に、しかも素早くこなせます。

複数のフォルダーを統合

1。「KUTOOLS PLUS」＞「フォルダの整理」をクリックし、「複数のフォルダを1 つのフォルダに整理する」ダイアログで「追加」をクリックして統合したいフォルダーをリストに追加し、その中から宛先フォルダーとして使用するフォルダーを1 つ選択します。

2。「OK」をクリックします。これにより、選択したフォルダー内のすべてのアイテムが指定されたフォルダーに統合されます。

重複アイテムを削除

3。「Kutools」＞「重複削除」＞「重複したメール」をクリックします。表示される「重複メール」ダイアログで、重複を削除するフォルダーにチェックを入れます。

4。「次へ」をクリックします。「重複メール設定」ダイアログで、メールを比較する基準を指定し、「重複メールを削除する」オプションにチェックを入れて、「単一のフォルダ内で比較する」を選択します。

5。「次へ」>「次へ」をクリックすると、重複したメールがフィルターされます。「重複メッセージを削除」ボタンをクリックしてから「OK」を押すと、重複したメールが正常に削除されます。