Outlookで重複することなくXNUMXつのフォルダーをXNUMXつのフォルダーにマージするにはどうすればよいですか？

Outlookでは、多数のフォルダーを持つ多数の電子メールアカウントを持っている場合があります。場合によっては、XNUMXつのフォルダーをXNUMXつにマージして、重複するアイテムを削除する必要があります。どうすればこの仕事をすばやく解決できますか？この記事では、Outlookでできるだけ早く処理できるようにVBAコードを紹介します。

VBAコードで重複のないXNUMXつのフォルダをXNUMXつにマージ

Kutools for Outlookを使用して、複数のフォルダーをマージし、重複するアイテムを削除します

VBAコードで重複のないXNUMXつのフォルダをXNUMXつにマージ

XNUMXつのフォルダーをXNUMXつにマージし、重複するアイテムを削除するには、次の手順でVBAコードを使用して処理できます。

1。押す Altキー+ F11 を有効にするためのキー アプリケーション向け Microsoft Visual Basic ウィンドウを使用して入力ファイルを追加します。

2.でダブルクリックします このOutlookSession から Project1 左側のペインで、以下のコードをコピーして右側のスクリプトに貼り付けます。

VBA：重複せずにXNUMXつのフォルダーをマージする

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

重複のないドキュメントマージフォルダ1

3。クリック ツール > 参考文献 ポップダイアログで、チェックします Microsoftスクリプトランタイム チェックボックスをオンにします。

4。クリック OK。今すぐプレス F5 コードを実行するためのキー。マージする最初のフォルダを選択するように促すダイアログが表示されます（注：最初のフォルダのすべてのアイテムは、XNUMX番目のフォルダとマージした後に削除されます）。
重複のないドキュメントマージフォルダ4

5。クリック OK、XNUMX番目のポップダイアログで、比較およびマージするXNUMX番目のフォルダーを選択します。
重複のないドキュメントマージフォルダ5

6。クリック OK、これで、最初のフォルダー内のすべてのアイテムがXNUMX番目のフォルダーに移動され、重複するアイテムも削除されます。
重複のないドキュメントマージフォルダ6

Kutools for Outlookを使用して、複数のフォルダーをマージし、重複するアイテムを削除します

VBAコードに慣れていない場合は、 Kutools for Outlook、便利なアドイン、 フォルダーの統合 & 重複するメール このジョブを簡単かつ迅速に処理できるユーティリティ。

Kutools for Outlook , 含まれています 100+ Microsoft Outlook 2016、2013、2010、およびOffice365の強力な機能とツール。
ダウンロードに移動 45日間の無料トライアル