-1

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
niton
  • 8,771
  • 21
  • 32
  • 52
  • 2
    This is tagged wrong, this isn't VBScript but VBA. – Rno Jun 29 '20 at 21:31
  • Does this answer your question? [Add a "CC recipient" to Outlook 2010 VBA](https://stackoverflow.com/questions/28904656/add-a-cc-recipient-to-outlook-2010-vba) – user692942 Jun 29 '20 at 23:11
  • @Lankymart It seems to be close to the solution but I've tried it before and couldn't get it to fit with my code – David Ciontea Jun 30 '20 at 02:25

2 Answers2

0

Replace the line

oResponse.CC = oResponse.CC & "; example@domain.com"

with

set recip = oResponse.Recipients.Add("example@domain.com")
recip.Type = olCC
Dmitry Streblechenko
  • 62,942
  • 4
  • 53
  • 78
0

Thanks everyone for the help but the missing piece is this one line that I found from this article https://learn.microsoft.com/en-us/office/vba/api/outlook.recipient.type and I also had to move oResponse.Display to the end

Dim oRecip As Outlook.Recipient

So now the final code looks like this

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()

' Adding the email to the existing emails as a CC
Dim oRecip As Outlook.Recipient
Set oRecip = oResponse.Recipients.Add("example@domain.com")
oRecip.Type = olCC

oResponse.Display
End Sub