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

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

Объединение двух папок без дубликатов в одну с помощью кода VBA

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

---

Объединение двух папок без дубликатов в одну с помощью кода VBA

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

1. Нажмите «Alt + F11», чтобы открыть окно Microsoft Visual Basic for Applications.

2. В левой области дважды щёлкните «ThisOutlookSession» в проекте «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

3. Выберите «Сервис» > «Ссылки», а затем в открывшемся диалоговом окне установите флажок «Microsoft Scripting Runtime».

4. Нажмите «ОК». Затем нажмите клавишу «F5», чтобы запустить код. Появится диалоговое окно с предложением выбрать первую папку для объединения (обратите внимание: все элементы из первой папки будут удалены после объединения со второй папкой).

5. Нажмите «ОК». Во втором диалоговом окне выберите вторую папку, с которой следует сравнить и объединить первую.

6. Нажмите «ОК». Все элементы из первой папки будут перемещены во вторую, а дубликаты — автоматически удалены.

---

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

Если вы не знакомы с кодом VBA, воспользуйтесь надстройкой «Kutools для Outlook» — с её утилитами «Организовать папки» и «Дубликаты писем» вы легко и быстро решите эту задачу.

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

1. Выберите «KUTOOLS PLUS» → «Организовать папки», затем в диалоговом окне «Организовать несколько папок в одну папку» нажмите «Добавить», чтобы включить в список нужные папки, и укажите папку назначения.

2. Нажмите «ОК» > «ОК». Теперь все элементы из выбранных папок объединены в указанной папке.

Удаление дубликатов

3. Выберите «Kutools» > «Удалить дубликаты» > «Дубликаты писем». В открывшемся диалоговом окне «Дубликаты писем» отметьте папку, в которой нужно удалить дубликаты.

4. Нажмите «Далее». В диалоговом окне «Параметры Дубликаты писем» укажите критерии сравнения писем. Затем установите флажок «Удалить дублированные электронные письма» и выберите «Сравнить в пределах одной папки».

5. Нажмите «Далее» > «Далее», чтобы отфильтровать дубликаты писем. Затем нажмите «Удалить дублирующиеся сообщения» > «ОК», чтобы успешно удалить дубликаты писем.