When my managers send an email to do some work,
then after I finish that work and press (reply or ReplyAll) and send that email,
I found I forgot to add some recipients (not included on the original mail).
I do not add these recipients to all my email replies, only if the mail.Body
or Subject
contains specific words. e.g “Test” or “vip”.
I already have added these recipients to a contact group with name e.g “5-Task Team”.
I need VBA to:
1- Check strings on the replied mail (after I click reply/All on the ribbon or choose it from context menu),
2- if it contains specific words, show a Message Box to remind me,
3- then add my contact group to the recipients (To Field)
I will send the mail manually.
The below code works only with showing the message box.
It fails to add the recipients (even if hard-coded), without any error raised.
This sub is found in a separate module:
Option Explicit
Option Compare Text
Sub Check_Body_before_sendReply()
Dim olMail As Outlook.MailItem
Set olMail = Application.ActiveExplorer().Selection(1)
Debug.Print olMail.Body
If olMail.Body Like "*Test*" Or olMail.Body Like "*VIP*" Then
MsgBox "Required strings are found"
olMail.Recipients.Add ("Test@Test.net") ‘hardcoded because I do not know how to add a contact group
Else
MsgBox "Not Found" 'just for testing purpose
End If
End Sub
This code is in ThisOutlookSession (no other code):
Option Explicit
Option Compare Text
Private WithEvents myAttExp As Explorer
Private WithEvents myAttOriginatorMail As MailItem
Dim WithEvents oMailItem As Outlook.MailItem
Private Sub Application_Startup()
Set myAttExp = ActiveExplorer
End Sub
Private Sub myAttOriginatorMail_Reply(ByVal Response As Object, Cancel As Boolean)
Check_Body_before_sendReply
End Sub
Private Sub myAttOriginatorMail_ReplyAll(ByVal Response As Object, Cancel As Boolean)
Check_Body_before_sendReply
End Sub
Private Sub myAttExp_SelectionChange()
On Error Resume Next
If TypeOf myAttExp.Selection.Item(1) Is MailItem Then
Set myAttOriginatorMail = myAttExp.Selection.Item(1)
End If
End Sub
Edit Response
not ActiveExplorer().Selection(1)
.
Private Sub myAttOriginatorMail_Reply(ByVal Response As Object, Cancel As Boolean)
Debug.Print Response.Body
If Response.Body Like "*Test*" Or Response.Body Like "*VIP*" Then
MsgBox "Required strings are found"
Response.Recipients.Add ("Test@Test.net")
Else
MsgBox "Not Found" 'just for testing purpose
End If
End Sub