Я думал, что это будет простой макрос, но я считаю невозможным добиться именно того, что вы просили; однако я достиг чего-то близкого. Я не удалил свой диагностический код, чтобы вы могли самостоятельно поэкспериментировать и, возможно, обнаружить последовательность утверждений, которые я не пробовал.
Это макрос, который вносит изменения:
Public Sub ReduceBody(ItemCrnt As Outlook.MailItem)
Dim ReducedBody As String
With ItemCrnt
' Not all items in Inbox are mail items. It should not be possible for
‘ a non-mail-item to reach this macro but check just in case.
If .Class = olMail Then
' I test for a particular subject and a particular sender
' Many properties of a mail item can be checked in this way. Adjust
' the If statement as necessary
If LCase(.Subject) = "attachments" And _
LCase(.SenderEmailAddress) = "xxxxx.com" Then
Debug.Print "Html: [" & Replace(Replace(.HtmlBody, vbLf, "{l}"), vbCr, "{r}") & "]"
Debug.Print "Text: [" & Replace(Replace(.Body, vbLf, "{l}"), vbCr, "{r}") & "]"
Debug.Print "Format: " & .BodyFormat
Debug.Assert False ' Have a look at the initial values of the properties
' Save reduced body because clearing the Html body also clears the text body
ReducedBody = Left$(.Body, 20)
.BodyFormat = olFormatPlain ' Set body format to plain text
.HtmlBody = "<BODY>" & ReducedBody & "</BODY>"
Debug.Print "Html: [" & .HtmlBody & "]"
Debug.Print "Text: [" & .Body & "]"
Debug.Print "Format: " & .BodyFormat
Debug.Assert False ' Have a look at the new values of the properties
.Close (olDiscard) ' Delete when the new
Exit Sub ‘ values are as you require
.Save ' Save amended mail item
End If
End If
End With
End Sub
Я считаю, что мои комментарии адекватно объясняют структуру макроса.
Как только макрос подтвердил, что элемент, который был передан, должен обрабатываться, он выводит текущие значения тела HTML, текста и формата тела в Immediate Window и использует Debug.Assert, чтобы остановить обработку , Нажмите F5 , когда вы будете готовы продолжить.
Код изменяет эти три свойства, отображает их новые значения и снова останавливается.
Я давно знал, что Outlook будет создавать текстовое тело из тела HTML, но я не осознавал, насколько связаны тело HTML, тело текста и формат тела. Изменение любого из них изменяет другие. Код модификации, который я предоставил, является лучшим, который я смог создать:
- Текстовое тело = первые 20 символов исходного текстового тела
- Html body = «» и первые 20 символов исходного текста текста & «»
- Формат тела = HTML
Когда вы перезапустите макрос с помощью F5 , изменения будут отменены. Если изменения не будут отменены, они будут сохранены, даже если вы не выполните команду сохранения. Сохраняйте заявления об отмене, пока отображаемые значения не будут приемлемыми.
Для проверки вышеуказанного макроса я использовал:
Sub TestReduceBody()
Dim Exp As Explorer
Dim ItemCrnt As MailItem
Set Exp = Outlook.Application.ActiveExplorer
If Exp.Selection.Count = 0 Then
Call MsgBox("Please select one or more emails then try again", vbOKOnly)
Exit Sub
Else
For Each ItemCrnt In Exp.Selection
Call ReduceBody(ItemCrnt)
Next
End If
End Sub
Я использую такой макрос для проверки всех моих новых почтовых сообщений, обрабатывающих макросы. Выберите один или несколько почтовых элементов, а затем запустите этот макрос. Этот макрос позволяет мне начать с простого электронного письма, и только при правильной обработке я пытаюсь использовать более сложные электронные письма. У меня есть несколько адресов электронной почты, и я отправил подходящие тестовые письма со вторичного аккаунта на мой основной аккаунт. У вас будут подлинные электронные письма, готовые к тестированию. Я настоятельно рекомендую использовать такие макросы.
Как только вы изменили первый макрос в соответствии с вашими требованиями, настройте правило и свяжите правило с этим макросом. Я предполагаю, что вы знаете, как создать правило, но я могу предоставить инструкции, если это необходимо.