Vba 抄送收件人不更新，无需检查姓名，回复全部

下面的代码在处理“全部回复”的最后一个区块（private sub afterReply或private sub oItem_ReplyAll）中，不必在事后检查名称，也不必检查前一个电子邮件地址example@domain.com.

有人建议收件人添加，但我无法让它工作

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

更换线路

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

与

---

感谢大家的帮助，但缺少的是我在本文中找到的这一行，我还必须将

或response.Display

移到末尾

Dim oRecip As Outlook.Recipient

最后的代码如下所示

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

---

这标记错误，这不是VBScript而是VBA。这是否回答了您的问题@Lankymart它似乎接近解决方案，但我以前尝试过，但5年前就无法使其与我的代码相匹配。@dmitry streblechenko这一点令人遗憾，因为我以前已经看到了答案。我刚刚得到编译错误：变量未定义，当我试图更改变量时，仍然无法使其工作。您需要声明

recip

变量。

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