抄送收件人被删除

时间:2019-06-24 18:10:46

标签: vba outlook outlook-vba

由于某些原因,下面的代码将覆盖“抄送”字段中的现有收件人。有什么方法可以调整此代码,以允许在添加example@domain.com时允许现有CC收件人存在?

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

'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 = "example@domain.com"
End Sub

编辑:感谢@ProfoundlyOblivious,我的代码现在看起来像这样,但是example @ domain现在在CC中显示了两次(如果它们以CC开头,则显示了三遍,可能事实是它显示了他们的显示名称是后者的问题)

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 = "example@domain.com"
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

    If oResponse.CC Like "example@domain.com" Then
        oResponse.CC = oResponse.CC
    Else
        oResponse.CC = oResponse.CC & "; example@domain.com"
    End If
End Sub

2 个答案:

答案 0 :(得分:2)

答案:oResponse.CC = oResponse.CC & "; example@domain.com"

如果电子邮件没有抄送收件人,则此答案将创建多余的分号和空格“; example@domain.com”。我敢肯定,Outlook会完全忽略它,但是如果它引起问题,您可能需要查看注释中提供的David Zemens示例。

重要说明:MailItem.CC仅引用CC显示名称,我的回答不能替代Recipients.Add

答案 1 :(得分:0)

请勿设置 fun parseCountryCode( phoneNumberStr: String?): String { val phoneUtil = PhoneNumberUtil.getInstance() return try { // phone must begin with '+' val numberProto = phoneUtil.parse(phoneNumberStr, "") numberProto.countryCode.toString() } catch (e: NumberParseException) { "" } } 属性-即使添加到属性CC,也不能保证CC包含电子邮件地址,仅包含显示名称,并且在再次解析名称时您会收到错误消息模棱两可的名字。

使用Recipients.Add添加抄送收件人:

set recip = oMail.Recipients.Add("example@domain.com")
recip.Type = olCC