Как удалить дубликаты событий календаря в Microsoft Outlook

Информация о материале
Категория: Макросы Outlook

После операций импорта/экспорта данных в Outlook нередко появляются дубликаты этих данных. Ранее уже рассматривался вопрос удаления дубликатов контактов адресной книги при помощи макроса VBA. Один из наших читателей по имени Артемий внес изменения в этот макрос и адаптировал его для решения задачи по удалению дубликатов событий календаря.

Поиск дубликатов ведется по признаку одинаковой темы события.

Sub Udalenie_dublikatov_Calendar()
Dim myOutlook As New Outlook.Application
Dim myNameSpace As NameSpace
Dim myFolder As MAPIFolder
Dim myWorkFolder As MAPIFolder
Dim iCount As Single, i As Single, j As Single, k As Single
Dim Str1 As String
Dim Str2 As String
Set myNameSpace = myOutlook.GetNamespace("MAPI")
Set myFolder = myNameSpace.GetDefaultFolder(olFolderCalendar)
'Set myWorkFolder = myFolder.Folders("ИмяПапки")
'в случае, если нужна папка внутри дефолтной
Set myWorkFolder = myFolder
'в случае, если используется папка "По умолчанию"
k = 1
Start:
iCount = myWorkFolder.Items.Count
    For i = k To iCount
        Str1 = myWorkFolder.Items.Item(i).Subject
        If Str1 <> "" Then
            For j = i To iCount
                On Error Resume Next
                Str2 = myWorkFolder.Items.Item(j).Subject
                    If Err.Number <> 0 Then
                        k = i
                        GoTo Start
                    End If
                If i <> j And Str1 = Str2 Then myWorkFolder.Items.Item(j).Delete
            Next j
        End If
    Next i
Set myOutlook = Nothing
End Sub

Для того, чтобы перенести этот программный код на свой компьютер, наведите курсор мыши на поле с программным кодом, нажмите на одну из двух кнопкокknopka_view_sourceв правом верхнем углу этого поля, скопируйте программный код и вставьте его в модуль проекта на своем компьютере (подробнее о том, как сохранить программный код макроса).

Другие материалы по теме: