Это не полный ответ.Мне нужно, чтобы вы обнаружили некоторую информацию, и этот ответ заставляет вас делать поиск, пока я кодирую следующий бит ответа.
Некоторые комментарии к существующему коду
Выпуск 1
Вы говорите, что не знаете, как удалить подсказки.Соответствующий код:
'If you don't want the prompt,
'You can remove the MsgBox line and its correspoding "Else … End If" lines.
If MsgBox("Do you want to remove the prefix '[EXTERNAL]'?", vbYesNo) = vbYes Then
strSubject = Replace(Item.Subject, "[EXTERNAL]", "", vbTextCompare)
Else
strSubject = Item.Subject
End If
Комментарий не очень полезен.Если у вас есть умеренное понимание VBA (или любого языка с конструкцией If ... Then ... Else ... End If), вы бы знали, как удалить подсказку.Если у вас нет умеренного понимания, комментарий неясен.Автор имеет в виду следующее:
Remove If MsgBox("Do you want to remove the prefix '[EXTERNAL]'?", vbYesNo) = vbYes Then
Keep strSubject = Replace(Item.Subject, "[EXTERNAL]", "", vbTextCompare)
Remove Else
Remove strSubject = Item.Subject
Remove End If
То есть удалите строку MsgBox, удалите строки Else…End If и оставьте все строки между Then и Else.
Выпуск 2
У вас есть второй блок, который удаляет «[EXTERNAL] Re:».Это не будет работать должным образом.
Первый блок поместил отредактированный или неотредактированный предмет в переменную strSubject.Второй блок проверяет Item.Subject, поэтому все, что сделал первый блок, будет потеряно.
Если вы изменили второй блок, чтобы проверить переменную strSubject, он все равно не будет работать, потому что вы удалили все «[EXTERNAL»] », Поэтому« [ВНЕШНЕЕ] Re: »не будет найдено.Если вы хотите удалить все «Xxxx» и все «XxxxYyyy» из строки, вы должны сначала удалить более длинную подстроку.
Issue 3
I doНе думаю, что второй блок может иметь эффект, который вы ищете.Большинство (Все?) Почтовых пакетов добавляют «Re:» или «RE:» что-то похожее на тему ответа.Почему только удалить «Re:» из внешних писем.Я бы удалил все или ни одного.Я подозреваю, что вы пытаетесь справиться с этой ситуацией:
- Аутсайдер Джон отправляет вам электронное письмо с темой «xxxxxxx»
- Эта тема изменена вашей системой на «[EXTERNAL] xxxxxxx».
- Вы отвечаете, и Outlook добавляет «RE:», чтобы дать «RE: [EXTERNAL] xxxxxxx»
- Джон отвечает, и ваша система меняет тему на «[EXTERNAL] RE: [EXTERNAL]xxxxxxx ».
- Вы отвечаете, и Outlook добавляет« RE: », чтобы дать« RE: [ВНЕШНИЙ] RE: [ВНЕШНИЙ] xxxxxxx ».
Если добавить код для удаления«[ВНЕШНИЙ] », у вас будут такие предметы, как« Re: Re: xxxxxxx »и« Re: Re: Re: xxxxxxx »и« Re: Re: Re: Re: xxxxxxx »в зависимости от того, как долго продолжалось ралли электронной почты«ВНЕШНИЕ» были удалены.Возможно, поможет удалить все «[EXTERNAL] Re:» перед удалением «[EXTERNAL]».
Выпуск 4
Не сохраняйте электронную почту, если вы ее не изменили.Ваш код сохраняет электронную почту, даже если она не изменилась.Я не знаю всего, что происходит, когда вы сохраняете электронное письмо, но я знаю, что Outlook экономит время, в которое электронное письмо было изменено, и явно должно найти место для исправленного электронного письма и отказаться от оригинальной версии.
Вам нужно что-токак:
strSubject = Item.Subject
Code to perform Edit 1 if appropriate.
Code to perform Edit 2 if appropriate.
Code to perform Edit 3 if appropriate.
: : : : : : :
If strSubject <> Item.Subject Then
Item.Subject = strSubject
Item.Save
End If
Разработка вашего нового кода
На мой взгляд, у вас есть три требования:
- Удалить «[EXTERNAL]»от темы и «Осторожно ...» от тела новых писем.
- Уберите все существующие письма в папке «Входящие», «Отправленные» или других папках.
- Уберите все новые ответы от посторонних наВаши ответы.
Я надеюсь, что код для требования 2 также будет обрабатывать требование 3, но это не является точным.Требование 1 является неотложным требованием, поскольку, как только оно будет выполнено, ситуация не ухудшится.Далее будут приведены электронные письма, на которые вы хотите ответить.Приведение в порядок старых разговоров может быть выполнено, когда у вас есть свободное время.
Чтобы проверить код, который, как мне кажется, поможет, мне понадобилось несколько тестовых писем.
В дополнительном аккаунте я создал простое письмо.Затем я добавил «[ВНЕШНИЙ]» к темеи «Предостережение электронной почты от внешнего источника» к телу в попытке соответствовать тому, что делает ваша система. Я отправил это письмо на мой основной аккаунт, где я ответил на него. Вернувшись к своей дополнительной учетной записи, я создал ответ и снова добавил «[EXTERNAL]» и «Осторожно, электронная почта из внешнего источника». После пары или повторов у меня было это письмо:
Subject: [EXTERNAL]RE: [EXTERNAL]RE: [EXTERNAL]Test
Caution email from external source
Reply 4
From: Tony@AcmeProducts.com
Sent: 04 April 2019 13:33
To: John@SomeOtherCompany.com
Subject: RE: [EXTERNAL]RE: [EXTERNAL]Test
Reply 3
From: John@SomeOtherCompany.com
Sent: 04 April 2019 13:30
To: Tony@AcmeProducts.com
Subject: [EXTERNAL]RE: [EXTERNAL]Test
Caution email from external source
Reply 2
From: Tony@AcmeProducts.com
Sent: 04 April 2019 13:20
To: John@SomeOtherCompany.com
Subject: RE: [EXTERNAL]Test
Reply 1
From: John@SomeOtherCompany.com
Sent: 04 April 2019 12:04
To: Tony@AcmeProducts.com
Subject: [EXTERNAL]Test
Caution email from external source
Test text. Test text. Test text. Test text. Test text.
Это то, что я вижу, когда открываю электронную почту, за исключением того, что я изменил значения «Кому» и «От», чтобы скрыть свои адреса электронной почты.
Текст вашего предупреждения будет отличаться от моего. Вероятно, вы можете просто удалить строку, которую видите, но, возможно, вы не можете, поэтому вы должны определить, что именно находится в теле HTML.
Скопируйте в модуль Outlook следующее:
Public Sub CallSubForSelectedEmails()
Dim Exp As Explorer
Dim InxA As Long
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
If ItemCrnt.Class = olMail Then
Call DsplCautionText(ItemCrnt)
End If
Next
End If
End Sub
Sub DsplCautionText(ItemCrnt As Outlook.MailItem)
Dim LcHtmlBody
Dim PosCaution As Long
Dim PosDsplStart As Long
With ItemCrnt
LcHtmlBody = LCase(.HtmlBody)
PosCaution = 1
Debug.Print "-----" & .ReceivedTime & " " & .Subject
Do While True
PosCaution = InStr(PosCaution, LcHtmlBody, "caution")
If PosCaution = 0 Then
' No [more] cautions
Exit Do
End If
If PosCaution <= 20 Then
PosDsplStart = 1
Else
PosDsplStart = PosCaution - 20
End If
Debug.Print PadL(PosDsplStart, 5) & " " & TidyTextForDspl(Mid$(.HtmlBody, PosDsplStart, 200))
PosCaution = PosCaution + 1
Loop
End With
End Sub
Public Function TidyTextForDspl(ByVal Text As String) As String
' Tidy Text for dsplay by replacing white space with visible strings:
' Leave single space unchanged
' Replace single LF by ‹lf›
' Replace single CR by ‹cr›
' Replace single TB by ‹tb›
' Replace single non-break space by ‹nbs›
' Replace single CRLF by ‹crlf›
' Replace multiple spaces by ‹# s› where # is number of repeats
' Replace multiple LFs by ‹# lf› of white space character
' Replace multiple CRs by ‹# cr›
' Replace multiple TBs by ‹# tb›
' Replace multiple non-break spaces by ‹# nbs›
' Replace multiple CRLFs by ‹# crlf›
' 15Mar16 Coded
' 3Feb19 Replaced "{" (\x7B) and "}" (\x7D) by "‹" (\u2039) and "›" (\u203A)
' on the grounds that the angle quotation marks were not likely to
' appear in text to be displayed.
' 5Feb19 Add code to treat CRLF as unit
' 28Mar19 Code to calculate PosWsChar after "<x>...<x>" converted to "<# x>"
' incorrect if "<x>...<x>" at the start of the string. Unlikely it
' was correct in other situations but this did not matter since the
' calculated value would be before the next occurrence of "<x>...<x>".
' But, if the string was near the beginning of the string, the
' calculated value was negative and the code crashed.
Dim InsStr As String
Dim InxWsChar As Long
Dim NumWsChar As Long
Dim PosWsChar As Long
Dim RetnVal As String
Dim WsCharCrnt As Variant
Dim WsCharValue As Variant
Dim WsCharDspl As Variant
WsCharValue = VBA.Array(" ", vbCr & vbLf, vbLf, vbCr, vbTab, Chr(160))
WsCharDspl = VBA.Array("s", "crlf", "lf", "cr", "tb", "nbs")
RetnVal = Text
' Replace each whitespace individually
For InxWsChar = 0 To UBound(WsCharValue)
RetnVal = Replace(RetnVal, WsCharValue(InxWsChar), "‹" & WsCharDspl(InxWsChar) & "›")
Next
' Look for repeats. If found replace <x><x><x><x>... by <# x>
For InxWsChar = 0 To UBound(WsCharValue)
'Debug.Assert InxWsChar <> 1
PosWsChar = 1
Do While True
InsStr = "‹" & WsCharDspl(InxWsChar) & "›"
PosWsChar = InStr(PosWsChar, RetnVal, InsStr & InsStr)
If PosWsChar = 0 Then
' No [more] repeats of this <x>
Exit Do
End If
' Have <x><x>. Count number of extra <x>s
NumWsChar = 2
Do While Mid(RetnVal, PosWsChar + NumWsChar * Len(InsStr), Len(InsStr)) = InsStr
NumWsChar = NumWsChar + 1
Loop
RetnVal = Mid(RetnVal, 1, PosWsChar - 1) & _
"‹" & NumWsChar & " " & WsCharDspl(InxWsChar) & "›" & _
Mid(RetnVal, PosWsChar + NumWsChar * Len(InsStr))
PosWsChar = PosWsChar + Len(InsStr) + Len(NumWsChar)
Loop
Next
' Restore any single spaces
RetnVal = Replace(RetnVal, "‹" & WsCharDspl(0) & "›", " ")
TidyTextForDspl = RetnVal
End Function
Я объясню приведенный выше код позже. На данный момент я просто хочу, чтобы вы выбрали несколько этих внешних писем и запустили макрос CallSubForSelectedEmails(). С моими электронными письмами я получаю немедленное окно вывода:
-----04/04/2019 13:34:24 [EXTERNAL]RE: [EXTERNAL]RE: [EXTERNAL]Test
2161 ><p class=MsoNormal>Caution email from external source<o:p></o:p></p><p class=MsoNormal><o:p> …
3551 ><p class=MsoNormal>Caution email from external source<o:p></o:p></p><p class=MsoNormal><o:p> …
4986 ><p class=MsoNormal>Caution email from external source<o:p></o:p></p><p class=MsoNormal><o:p> …
-----04/04/2019 13:30:10 [EXTERNAL]RE: [EXTERNAL]Test
1953 ><p class=MsoNormal>Caution email from external source<o:p></o:p></p><p class=MsoNormal><o:p> …
3290 ><p class=MsoNormal>Caution email from external source<o:p></o:p></p><p class=MsoNormal><o:p> …
-----04/04/2019 12:04:09 [EXTERNAL]Test
1563 ><p class=MsoNormal>Caution email from external source<o:p></o:p></p><p class=MsoNormal><o:p> …
Примечание 1: ... указывает, что я обрезал строки. Примечание 2: первый текст предостережения находится в позиции символа 1953 в теле HTML, поскольку в заголовке много символов. Примечание 3: для каждой строки я искал «Осторожно» и затем отображал 200 символов, начиная с 20 символов назад. Я обрезал строки, потому что в этом случае мне не нужна вся эта информация. Я надеюсь, что вы тоже не знаете.
Все, что в угловых скобках, является тегом Html. «
» является начальным тегом. «
» является конечным тегом. В моих письмах текст предупреждения не содержит каких-либо тегов. Это означает, что я могу заменить «Предостережение по электронной почте из внешнего источника» на «» без вмешательства в HTML. Я ожидаю, что ваш текст предупреждения похож, но это может быть не так.
Пожалуйста, запустите макрос CallSubForSelectedEmails(), как я и просил. Текст вашего предупреждения прост? Все ли примеры одинаковы?