Как в Outlook объединить две папки без дубликатов в одну папку?

В Outlook у вас может быть много учетных записей электронной почты с множеством папок, в некоторых случаях вы хотите объединить две папки в одну и удалить повторяющиеся элементы. Как можно быстро решить эту задачу? В этой статье я представляю код VBA, который поможет вам как можно быстрее справиться с этим в Outlook.

Объединить две папки без дубликатов в одну по коду VBA

Объедините несколько папок и удалите повторяющиеся элементы с помощью Kutools for Outlook

Объединить две папки без дубликатов в одну по коду VBA

Чтобы объединить две папки в одну и удалить повторяющиеся элементы, вы можете обработать это с помощью кода VBA, выполнив следующие действия:

1. Нажмите Alt + F11 ключи для включения Microsoft Visual Basic для приложений окно

2. Дважды щелкните на Эта сессия Outlook от Project1 на левой панели, затем скопируйте и вставьте приведенный ниже код в правый скрипт.

VBA: объединить две папки без дубликатов

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

doc объединить папки без дубликатов 1

3. Нажмите Инструменты > Рекомендации и в появившемся диалоговом окне отметьте Среда выполнения сценариев Microsoft флажок.

4. Нажмите OK, Теперь нажмите F5 ключ для запуска кода. Появится диалоговое окно, напоминающее вам о выборе первой папки, которую вы хотите объединить (примечание: все элементы в первой папке будут удалены после объединения со второй папкой).
doc объединить папки без дубликатов 4

5. Нажмите OK, во втором диалоговом окне выберите вторую папку, которую вы хотите сравнить и объединить.
doc объединить папки без дубликатов 5

6. Нажмите OK, теперь все элементы из первой папки будут перемещены во вторую папку, а дубликаты также будут удалены.
doc объединить папки без дубликатов 6

Объедините несколько папок и удалите повторяющиеся элементы с помощью Kutools for Outlook

Если вы не знакомы с кодом VBA, попробуйте использовать Kutools for Outlook, удобная надстройка с ее Объединение папок и Повторяющиеся электронные письма утилиты, которые могут легко и быстро справиться с этой работой.

Kutools for Outlook , Тур включает: 100+ мощные функции и инструменты для Microsoft Outlook 2016, 2013, 2010 и Office 365.
Перейти к загрузке Бесплатная пробная версия 45 дней

Бесплатная установка Kutools for Outlook, а затем выполните следующие действия:

Объединение нескольких папок

1. Нажмите Кутулс Плюс > Объединение папок, то в Объединить несколько папок в одну диалоговое окно, нажмите Добавить чтобы добавить папки в список, который будет объединен, выберите папку в качестве папки назначения.

2. Нажмите OK > OK. Теперь все элементы в выбранных папках были объединены в одну конкретную папку.
документ объединить и удалить дубликат 2

Удалить повторяющиеся элементы

3. Нажмите Кутулс > Удалить дубликат > Повторяющиеся электронные письма. Тогда в Повторяющиеся сообщения выберите папку, в которой вы хотите удалить дубликаты.

4. Нажмите Следующая и отправлять адресату Настройки повторяющихся сообщений диалоговом окне укажите критерии, которые вы используете для сравнения электронных писем, затем установите флажок Удалять повторяющиеся сообщения выберите и выберите Сравнить на наличие повторяющихся сообщений в одной папке.

5. Нажмите Следующая > Следующая, повторяющиеся письма были отфильтрованы. Нажмите Удалить повторяющееся сообщение кнопка> OK чтобы успешно удалить повторяющиеся электронные письма.
doc объединить папки без дубликатов 6