Содержание
Вопрос или проблема
У меня есть макрос VBA, который форматирует текст так, как мне нравится. Однако, когда имеются гиперссылки, электронные почты или упоминания (т.е. @Tom), проверки Regex включают строки, не соответствующие необходимому формату.
Мое решение будет заключаться в том, чтобы сначала удалить все гиперссылки в проектируемом электронном письме перед запуском моего макроса форматирования, чтобы он мог форматировать текст без гиперссылок.
Ниже приведен код, который я написал для форматирования, но я испытываю трудности с тем, где я могу включить удаление гиперссылок:
Sub ValidateAndFormatText()
Dim olApp As Object
Dim olInspector As Object
Dim olMailItem As Object
Dim olRange As Object
Dim re As Object
Dim signatureStart As Long
Dim signatureEnd As Long
Dim textToValidate As String
Dim match As Object
' Инициализация объектов Outlook
Set olApp = CreateObject("Outlook.Application")
Set olInspector = olApp.ActiveInspector
Set olMailItem = olInspector.currentItem
Set olRange = olMailItem.GetInspector.WordEditor.Range
' Определите ваш текст подписи
Dim signatureText As String
signatureText = "С уважением,"
' Найдите позицию подписи
signatureStart = InStr(1, olRange.Text, signatureText, vbTextCompare)
signatureEnd = signatureStart + Len(signatureText)
' Извлеките текст выше подписи
textToValidate = Left(olRange.Text, signatureStart - 1)
' Инициализация регулярного выражения
Set re = CreateObject("VBScript.RegExp")
re.Global = True
re.IgnoreCase = True
' Проверка и форматирование денежных сумм
re.Pattern = "\$[0-9]{1,3}(([\.?,?][0-9]{1,3}){1,})?\b"
For Each match In re.Execute(textToValidate)
olRange.Start = match.FirstIndex
olRange.End = match.FirstIndex + match.Length
olRange.Font.Bold = True
olRange.Font.Color = RGB(8, 30, 54) ' Темно-синий
Next match
' Проверка и форматирование денежных сумм
re.Pattern = "\$[0-9]{1,3}[KM]\b"
For Each match In re.Execute(textToValidate)
olRange.Start = match.FirstIndex
olRange.End = match.FirstIndex + match.Length
olRange.Font.Bold = True
olRange.Font.Color = RGB(8, 30, 54) ' Темно-синий
Next match
' Проверка и форматирование временных значений (например, 10:30 AM)
re.Pattern = "\b\d{1,2}:\d{2}(?:\s?[AaPp](\.?)[Mm]\1)?"
For Each match In re.Execute(textToValidate)
olRange.Start = match.FirstIndex
olRange.End = match.FirstIndex + match.Length
olRange.Font.Bold = True
olRange.Font.Color = RGB(8, 30, 54) ' Темно-синий
Next match
' Проверка любых цифр с или без знаков процента
re.Pattern = "[0-9]{1,3}(.[0-9]{1,2})?\%"
For Each match In re.Execute(textToValidate)
olRange.Start = match.FirstIndex
olRange.End = match.FirstIndex + match.Length
olRange.Font.Bold = True
olRange.Font.Color = RGB(8, 30, 54) ' Темно-синий
Next match
' Число Долгий
re.Pattern = "\b(?:два|три|четыре|пять|шесть|семь|восемь|девять|десять|одиннадцать|двенадцать|тринадцать|четырнадцать|пятнадцать|шестнадцать|семнадцать|восемнадцать|девятнадцать|двадцать|тридцать|сорок|пятьдесят|шестьдесят|семьдесят|восемьдесят|девяносто)(-день)?\b(\s\([0-9]{1,}\))?"
For Each match In re.Execute(textToValidate)
olRange.Start = match.FirstIndex
olRange.End = match.FirstIndex + match.Length
olRange.Font.Bold = True
olRange.Font.Color = RGB(8, 30, 54) ' Темно-синий
Next match
' День недели
re.Pattern = "\b(Счастливый)? (Понедельник|Вторник|Среда|Четверг|Пятница|Суббота|Воскресенье)\b"
For Each match In re.Execute(textToValidate)
olRange.Start = match.FirstIndex
olRange.End = match.FirstIndex + match.Length
olRange.Font.Bold = True
olRange.Font.Color = RGB(8, 30, 54) ' Темно-синий
Next match
' Случайные коды и т.д.
re.Pattern = "\b(([0-9]{1,}) psi|([0-9]{1,}) PSI|NFPA (25)|([0-9]{1,}) GPM|([0-9]{1,}) mph|([0-9]{1,}) MPH)\b"
For Each match In re.Execute(textToValidate)
olRange.Start = match.FirstIndex
olRange.End = match.FirstIndex + match.Length
olRange.Font.Bold = True
olRange.Font.Color = RGB(8, 30, 54) ' Темно-синий
Next match
' Гражданский кодекс
re.Pattern = "\bГражданский кодекс \d{4}(\(?[a-zA-Z]\)?)?"
For Each match In re.Execute(textToValidate)
olRange.Start = match.FirstIndex
olRange.End = match.FirstIndex + match.Length
olRange.Font.Bold = True
olRange.Font.Color = RGB(8, 30, 54) ' Темно-синий
Next match
' Палос Вердес Бей Клаб Строение и Подразделения
re.Pattern = "\b[0-9]{1,2}-([A-H]|[0-9]{3})\b"
For Each match In re.Execute(textToValidate)
olRange.Start = match.FirstIndex
olRange.End = match.FirstIndex + match.Length
olRange.Font.Bold = True
olRange.Font.Color = RGB(8, 30, 54) ' Темно-синий
Next match
' Число (00)
re.Pattern = "\b(?:два|три|четыре|пять|шесть|семь|восемь|девять|десять|одиннадцать|двенадцать|тринадцать|четырнадцать|пятнадцать|шестнадцать|семнадцать|восемнадцать|девятнадцать|двадцать|тридцать|сорок|пятьдесят|шестьдесят|семьдесят|восемьдесят|девяносто)(\s\(\d+\))?\b"
For Each match In re.Execute(textToValidate)
olRange.Start = match.FirstIndex
olRange.End = match.FirstIndex + match.Length
olRange.Font.Bold = True
olRange.Font.Color = RGB(8, 30, 54) ' Темно-синий
Next match
' 28-дневный период комментариев
re.Pattern = "\b28-дневный\s(период комментариев)?"
For Each match In re.Execute(textToValidate)
olRange.Start = match.FirstIndex
olRange.End = match.FirstIndex + match.Length
olRange.Font.Bold = True
olRange.Font.Color = RGB(8, 30, 54) ' Темно-синий
Next match
' Проверка и форматирование длинных дат (например, Воскресенье, 9 мая 2024)
re.Pattern = "\b((?:Воскресенье|Понедельник|Вторник|Среда|Четверг|Пятница|Суббота),\s)?(?:Январь|Февраль|Март|Апрель|Июнь|Июль|Август|Сентябрь|Октябрь|Ноябрь|Декабрь) (\d{1,2}(,)?) \d{4}\b"
For Each match In re.Execute(textToValidate)
olRange.Start = match.FirstIndex
olRange.End = match.FirstIndex + match.Length
olRange.Font.Bold = True
olRange.Font.Color = RGB(8, 30, 54) ' Темно-синий
Next match
' Проверка и форматирование длинных дат (например, 02/14/2024)
re.Pattern = "(?:Январь|Февраль|Март|Апрель|Июнь|Июль|Август|Сентябрь|Октябрь|Ноябрь|Декабрь)(\s\d{1,4})?(,?\s\d{4})?"
For Each match In re.Execute(textToValidate)
olRange.Start = match.FirstIndex
olRange.End = match.FirstIndex + match.Length
olRange.Font.Bold = True
olRange.Font.Color = RGB(8, 30, 54) ' Темно-синий
Next match
Set re = CreateObject("VBScript.RegExp")
re.Global = True
re.IgnoreCase = False
' Проверка и форматирование длинных дат (например, Воскресенье, 9 мая 2024)
re.Pattern = "\b((?:Воскресенье|Понедельник|Вторник|Среда|Четверг|Пятница|Суббота),\s)?(?:Январь|Февраль|Март|Апрель|Май\b|Июнь|Июль|Август|Сентябрь|Октябрь|Ноябрь|Декабрь) (\d{1,2}(,)?) \d{4}\b"
For Each match In re.Execute(textToValidate)
olRange.Start = match.FirstIndex
olRange.End = match.FirstIndex + match.Length
olRange.Font.Bold = True
olRange.Font.Color = RGB(8, 30, 54) ' Темно-синий
Next match
' Проверка и форматирование длинных дат (например, 02/14/2024)
re.Pattern = "(?:Январь|Февраль|Март|Апрель|Май\b|Июнь|Июль|Август|Сентябрь|Октябрь|Ноябрь|Декабрь)(\s\d{1,4})?(,?\s\d{4})?"
For Each match In re.Execute(textToValidate)
olRange.Start = match.FirstIndex
olRange.End = match.FirstIndex + match.Length
olRange.Font.Bold = True
olRange.Font.Color = RGB(8, 30, 54) ' Темно-синий
Next match
Set re = CreateObject("VBScript.RegExp")
re.Global = True
re.IgnoreCase = True
' [#XN] номер
re.Pattern = "\[#XN[0-9]{7}\]"
For Each match In re.Execute(textToValidate)
olRange.Start = match.FirstIndex
olRange.End = match.FirstIndex + match.Length
olRange.Font.Bold = True
olRange.Font.Color = RGB(8, 30, 54) ' Темно-синий
Next match
' Проверка и форматирование дат (например, 02/14/2024)
re.Pattern = "\b[0-9]{1,2}[/-][0-9]{1,2}([/-][0-9]{2,4})?\b"
For Each match In re.Execute(textToValidate)
olRange.Start = match.FirstIndex
olRange.End = match.FirstIndex + match.Length
olRange.Font.Bold = True
olRange.Font.Color = RGB(8, 30, 54) ' Темно-синий
Next match
End Sub
Ответ или решение
Удаление гиперссылок в VBA перед форматированием текста
Если вы работаете с макросами VBA для Outlook и сталкиваетесь с проблемой, связанной с гиперссылками, которые мешают вашей валидации текста, лучшим решением будет сначала удалить все гиперссылки перед форматированием текста. Ниже представлена модифицированная версия вашего кода с включением функции для удаления гиперссылок.
1. Код для удаления гиперссылок
Добавление функции для удаления гиперссылок перед основной логикой вашего макроса позволит вам гарантировать, что форматирование текста выполнится корректно.
Sub ValidateAndFormatText()
Dim olApp As Object
Dim olInspector As Object
Dim olMailItem As Object
Dim olRange As Object
Dim re As Object
Dim signatureStart As Long
Dim signatureEnd As Long
Dim textToValidate As String
Dim match As Object
' Инициализация объектов Outlook
Set olApp = CreateObject("Outlook.Application")
Set olInspector = olApp.ActiveInspector
Set olMailItem = olInspector.CurrentItem
Set olRange = olMailItem.GetInspector.WordEditor.Range
' Удаление всех гиперссылок
RemoveHyperlinks olMailItem
' Определите ваш текст подписи
Dim signatureText As String
signatureText = "С уважением,"
' Найдите позицию подписи
signatureStart = InStr(1, olRange.Text, signatureText, vbTextCompare)
signatureEnd = signatureStart + Len(signatureText)
' Извлеките текст выше подписи
textToValidate = Left(olRange.Text, signatureStart - 1)
' Инициализация регулярного выражения
Set re = CreateObject("VBScript.RegExp")
re.Global = True
re.IgnoreCase = True
' Пример кода для валидации и форматирования текстов
' ...
End Sub
Private Sub RemoveHyperlinks(olMailItem As Object)
Dim hl As Object
Dim i As Long
' Цикл по всем гиперссылкам и их удаление
For i = olMailItem.Hyperlinks.Count To 1 Step -1
Set hl = olMailItem.Hyperlinks(i)
hl.Delete
Next i
End Sub2. Пояснение изменений
-
Функция
RemoveHyperlinks: Этот новый метод принимает объект письмаolMailItemи удаляет все гиперссылки. Он делает это, перебирая все гиперссылки в коллекции и вызывая методDelete. -
Вызов
RemoveHyperlinks: В начале вашей основной процедурыValidateAndFormatText, перед началом валидации текста, мы вызываем новую функциюRemoveHyperlinks.
3. Заключение
С такими изменениями ваш макрос будет сначала очищать текст от гиперссылок, что позволит вам избежать проблем с валидацией и форматированием текста в дальнейшем. Убедившись, что ваш код выполняется логично и последовательно, вы значительно улучшите его надежность и читаемость. Если у вас возникнут дополнительные вопросы или вам понадобится помощь в других аспектах работы с VBA, не стесняйтесь обращаться.