Вопрос или проблема
У меня есть работающая макрос 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
для извлечения всех элементов текущей цепочки. Также важно понимать, как в данный момент происходит выбор элементов и как преобразовать этот процесс в такой, что обрабатывалась бы вся цепочка.
Пример
Рассмотрим пример, который итерируется по всем элементам хранения цепочки. Основные этапы будут следующие:
- Получите выбранный элемент в Outlook.
- Инициализируйте объект Conversation.
- Получите все элементы в цепочке.
- Итерируйтесь по каждому элементу и редактируйте их.
Вот пример кода, который это делает:
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
Применение
-
Удаление категорий и флага выполнения: данная процедура автоматически итерируется по всем сообщениям в выбранной цепочке, удаляя категории "NOW ACTIONS", "NEXT ACTIONS" и "WAITING", а также, если это предусмотрено, очищает флаги выполнения.
-
Универсальность выбора: корректно работает как при выборе одного письма, так и всей цепочки.
-
Обработка ошибок: захватывает случаи, когда невозможно получить цепочку для выбранного письма и информирует об этом пользователя.
Таким образом, внеся данные изменения, вы сможете обрабатывать все сообщения в цепочке, что существенно повысит эффективность и удобство работы. Наличие этих возможностей облегчит удаление одновременно нескольких нежелательных категорий и флагов из всей цепочки электронной переписки.