The code below, in the last chunk that handles the reply all (private sub afterReply or private sub oItem_ReplyAll), doesn't add the previous email address without having to check name afterwards and same for the example@domain.com.
Someone suggested Recipient.Add
but I can't get it to work.
Option Explicit
Private WithEvents oExpl As Explorer
Private WithEvents oItem As MailItem
Private bDiscardEvents As Boolean
Dim oResponse As MailItem
Dim WithEvents objInspectors As Outlook.Inspectors
Dim WithEvents objMailItem As Outlook.MailItem
Dim WithEvents myOlExp As Outlook.Explorer
Private Sub Application_Startup()
Initialize_handler
Set oExpl = Application.ActiveExplorer
bDiscardEvents = False
End Sub
Public Sub Initialize_handler()
Set objInspectors = Application.Inspectors
Set myOlExp = Application.ActiveExplorer
End Sub
Private Sub objInspectors_NewInspector(ByVal Inspector As Inspector)
If Inspector.CurrentItem.Class = olMail Then
Set objMailItem = Inspector.CurrentItem
If objMailItem.Sent = False Then
Call SetFromAddress(objMailItem)
End If
End If
End Sub
'The next 3 lines to enable Outlook 2013/2016/365 Reading Pane Reply
Private Sub myOlExp_InlineResponse(ByVal objItem As Object)
Call SetFromAddress(objItem)
End Sub
Public Sub SetFromAddress(oMail As Outlook.MailItem)
' Set your preferred default From address below.
' Exchange permissions determine if it is actually stamped
' as "Sent On Behalf Of" or "Sent As".
' The address is not properly updated for the InlineResponse
' feature in Outlook 2013/2016/365. This is only a visual bug.
oMail.SentOnBehalfOfName = "example@domain.com"
oMail.CC = oMail.CC
End Sub
Private Sub oExpl_SelectionChange()
On Error Resume Next
Set oItem = oExpl.Selection.item(1)
End Sub
'on Reply
Private Sub oItem_Reply(ByVal Response As Object, Cancel As Boolean)
Cancel = True
bDiscardEvents = True
Set oResponse = oItem.Reply
afterReply
End Sub
'on Forward
Private Sub oItem_Forward(ByVal Response As Object, Cancel As Boolean)
Cancel = True
bDiscardEvents = True
Set oResponse = oItem.Forward
afterReply
End Sub
'On Reply All
Private Sub oItem_ReplyAll(ByVal Response As Object, Cancel As Boolean)
Cancel = True
bDiscardEvents = True
Set oResponse = oItem.ReplyAll
afterReply
End Sub
Private Sub afterReply()
oResponse.Display
' do whatever here with .to, .cc, .cci, .subject, .HTMLBody, .Attachements.Add, etc.
oResponse.CC = oResponse.CC & "; example@domain.com"
End Sub