Как удалить категории из всей цепочки электронных писем в Outlook?

Вопрос или проблема

У меня есть работающая макрос VBA в Outlook, которая удаляет определенные категории ("NOW ACTIONS", "NEXT ACTIONS" и "WAITING") из одного письма. Она также снимает флажок “с последующей обработкой”, если он установлен. Макрос работает нормально, когда выбрано индивидуальное письмо.

Текущий рабочий код (для одного письма)

Sub RemoveFlagAndCategories2()
    Dim objItem As Object
    Dim objMail As MailItem
    Dim categoryList As String
    Dim categoriesToRemove As Variant
    Dim category As Variant

    ' Проверка, выбраны ли элементы
    If Application.ActiveExplorer.Selection.Count = 0 Then
        MsgBox "Письмо не выбрано", vbExclamation
        Exit Sub
    End If

    ' Определение категорий для удаления
    categoriesToRemove = Array("NOW ACTIONS", "NEXT ACTIONS", "WAITING")

    ' Перебор выбранных элементов
    For Each objItem In Application.ActiveExplorer.Selection
        ' Проверка, является ли выбранный элемент письмом
        If TypeOf objItem Is MailItem Then
            Set objMail = objItem

            ' Удаление флага, если он установлен
            If objMail.IsMarkedAsTask Then
                objMail.ClearTaskFlag
            End If

            ' Получение текущих категорий письма
            categoryList = objMail.Categories

            ' Перебор категорий для удаления
            For Each category In categoriesToRemove
                If InStr(1, categoryList, category, vbTextCompare) > 0 Then
                    ' Удаление категории, если она существует
                    categoryList = Trim(Replace(categoryList, category, "", , , vbTextCompare))
                End If
            Next category

            ' Удаление лишних запятых или пробелов
            categoryList = Replace(categoryList, ", ,", ",")
            categoryList = Trim(categoryList)
            If Left(categoryList, 1) = "," Then categoryList = Mid(categoryList, 2)
            If Right(categoryList, 1) = "," Then categoryList = Left(categoryList, Len(categoryList) - 1)

            ' Обновление категорий письма
            objMail.Categories = categoryList

            ' Сохранение изменений
            objMail.Save
        End If
    Next objItem
End Sub

С чем мне нужна помощь

Я хочу изменить этот макрос, чтобы удалить категории из всех писем в одной цепочке переписки, а не только из выбранного письма.

Что я пробовал

  • Я пытался получить цепочку переписки с помощью GetConversation и перебрать GetRootItems, но когда я выбираю цепочку, а не индивидуальное письмо, макрос все равно говорит "Письмо не выбрано."
  • Я также пробовал использовать GetTable, но не уверен, как правильно перебрать все письма в цепочке.

Желаемое поведение

  • Если я выбираю одиночное письмо, удаляются категории из всех писем в одной цепочке переписки.
  • Если я выбираю цепочку переписки в сгруппированном виде Outlook, удаляются категории из всех писем в этой цепочке.

Ключевые требования

  • Удалять "NOW ACTIONS", "NEXT ACTIONS" и "WAITING" из каждого письма в цепочке переписки.
  • Снять флажки последующей обработки, если они установлены.
  • Убедиться, что выбор индивидуального письма или всей цепочки переписки работает как ожидается.

У кого-нибудь есть пример, как правильно обработать все письма в цепочке переписки?

Ответ или решение

Для того чтобы решить задачу удаления категорий из всей цепочки электронной почты в Outlook, необходимо адаптировать ваш текущий VBA-макрос, который работает с отдельными письмами, чтобы он мог обрабатывать все письма в цепочке. Это более сложная задача, но используя объекты Outlook и методы, доступные в VBA, её можно решить эффективно.

Теория

Ваша задача заключается в обработке всех сообщений в одной цепочке (conversation) в Outlook, а не только одного сообщения. В Outlook это можно сделать с помощью метода GetConversation, который позволяет получить доступ ко всей цепочке, включая её корневые и подчинённые элементы. После этого возможно провести операции с каждой отдельной электронной почтой, включая удаление указанных категорий и флага на выполнение.

Для достижения цели необходимо использовать метод GetTable для извлечения всех элементов текущей цепочки. Также важно понимать, как в данный момент происходит выбор элементов и как преобразовать этот процесс в такой, что обрабатывалась бы вся цепочка.

Пример

Рассмотрим пример, который итерируется по всем элементам хранения цепочки. Основные этапы будут следующие:

  1. Получите выбранный элемент в Outlook.
  2. Инициализируйте объект Conversation.
  3. Получите все элементы в цепочке.
  4. Итерируйтесь по каждому элементу и редактируйте их.

Вот пример кода, который это делает:

Sub RemoveFlagAndCategoriesFromConversation()
    Dim objMail As MailItem
    Dim objConversation As Outlook.Conversation
    Dim objTable As Table
    Dim objRow As Row
    Dim categoriesToRemove As Variant
    Dim categoryList As String
    Dim category As Variant

    categoriesToRemove = Array("NOW ACTIONS", "NEXT ACTIONS", "WAITING")

    ' Проверка, что есть выбранные элементы
    If Application.ActiveExplorer.Selection.Count = 0 Then
        MsgBox "Нет выбранных сообщений", vbExclamation
        Exit Sub
    End If

    ' Начинаем обработку первого выбранного элемента
    If TypeOf Application.ActiveExplorer.Selection(1) Is MailItem Then
        Set objMail = Application.ActiveExplorer.Selection(1)
        Set objConversation = objMail.GetConversation

        If Not objConversation Is Nothing Then
            Set objTable = objConversation.GetTable

            ' Итерация по всем сообщениям в цепочке
            Do Until objTable.EndOfTable
                Set objRow = objTable.GetNextRow
                Set objMail = Application.Session.GetItemFromID(objRow("EntryID"))

                ' Удаление категории и флага выполнения
                If TypeOf objMail Is MailItem Then
                    categoryList = objMail.Categories

                    For Each category In categoriesToRemove
                        If InStr(1, categoryList, category, vbTextCompare) > 0 Then
                            categoryList = Trim(Replace(categoryList, category, "", , , vbTextCompare))
                        End If
                    Next category

                    categoryList = Replace(categoryList, ", ,", ",")
                    categoryList = Trim(categoryList)
                    If Left(categoryList, 1) = "," Then categoryList = Mid(categoryList, 2)
                    If Right(categoryList, 1) = "," Then categoryList = Left(categoryList, Len(categoryList) - 1)

                    objMail.Categories = categoryList

                    If objMail.IsMarkedAsTask Then
                        objMail.ClearTaskFlag
                    End If

                    objMail.Save
                End If
            Loop
        Else
            MsgBox "Не удалось получить цепочку для данного сообщения", vbExclamation
        End If
    End If
End Sub

Применение

  1. Удаление категорий и флага выполнения: данная процедура автоматически итерируется по всем сообщениям в выбранной цепочке, удаляя категории "NOW ACTIONS", "NEXT ACTIONS" и "WAITING", а также, если это предусмотрено, очищает флаги выполнения.

  2. Универсальность выбора: корректно работает как при выборе одного письма, так и всей цепочки.

  3. Обработка ошибок: захватывает случаи, когда невозможно получить цепочку для выбранного письма и информирует об этом пользователя.

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

Оцените материал
Добавить комментарий

Капча загружается...