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

Автор: Слънце Последна промяна: 2020-10-29

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

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

Обединете множество папки и премахнете дублиращи се елементи с Kutools за Outlook

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

За да обедините две папки в една и да премахнете дублиращите се елементи, можете да го обработите с VBA код, както следва:

1. Натиснете Alt + F11 клавиши за активиране на Microsoft Visual Basic за приложения прозорец

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

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

3. кликване Инструменти > Препратки и в изскачащия диалогов прозорец поставете отметка Microsoft Scripting Runtime отметката.

doc обединяване на папки без дубликати 2

doc обединяване на папки без дубликати 3

4. кликване OK, Сега натиснете F5 ключ за изпълнение на кода. Изскача диалогов прозорец, за да ви напомни да изберете първата папка, която искате да обедините (забележка: всички елементи в първата папка ще бъдат премахнати след сливането с втората папка).
doc обединяване на папки без дубликати 4

5. кликване OK, във втория изскачащ диалогов прозорец изберете втората папка, с която искате да сравните и да се обедините.
doc обединяване на папки без дубликати 5

6. кликване OK, сега всички елементи в първата папка ще бъдат преместени във втората папка, а дублиращите се също ще бъдат премахнати.
doc обединяване на папки без дубликати 6

Обединете множество папки и премахнете дублиращи се елементи с Kutools за Outlook

Ако не сте запознати с VBA кода, опитайте да използвате Kutools за Outlook, удобна добавка, със своите Консолидиране на папки намлява Дублирани имейли помощни програми, които могат лесно и бързо да се справят с тази работа.

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

Безплатна инсталация Kutools за Outlook и след това направете стъпките по-долу:

Обединете няколко папки

1. кликване Kutools плюс > Консолидиране на папки, след това в Обединете няколко папки в една кликнете върху Добави за да добавите папките в списъка, който ще бъде обединен, изберете папка като целева папка.

2. кликване OK > OK. Сега всички елементи в избраните папки са обединени в една конкретна папка.
doc консолидиране и премахване на дубликат 2

Премахване на дублирани елементи

3. кликване Kutools > Изтриване на дубликат > Дублирани имейли. Тогава в Дублирани съобщения диалогов прозорец, проверете папката, която искате да премахнете дубликати.

4. кликване Напредв Настройки за дублирани съобщения диалогов прозорец, посочете критериите, които използвате за сравняване на имейли, след което проверете Изтриване на дублирани съобщения опция и изберете Сравнете за дублиращи се съобщения в една папка.

5. кликване Напред > Напред, дублиращите се имейли са филтрирани. Кликнете Изтриване на дублирано съобщение бутон> OK за успешно премахване на дублиращите се имейли.
doc обединяване на папки без дубликати 6