需要在不发送邮件的情况下在回复中添加抄送

问题描述

抱歉我对 VBA 的了解为零 :)

我的朋友给了我这个代码，当我需要回复选定的邮件并删除我公司（XYZ 公司）中域包含“XYZ”的所有收件人时，我会使用该代码

代码如下：

Function GetCurrentItem() As Object
On Error Resume Next
Select Case TypeName(Application.ActiveWindow)
Case "Explorer"
Set GetCurrentItem = Application.ActiveExplorer.Selection.Item(1)
Case "Inspector"
Set GetCurrentItem = Application.ActiveInspector.CurrentItem
End Select
End Function

Sub RemoveRecipients() 'Item As Outlook.MailItem)
'Dim RemoveThis As VBA.Collection
Dim oReply As Outlook.MailItem
Set Item = GetCurrentItem()

'Set RemoveThis = New VBA.Collection

' here add addresses
'RemoveThis.Add "[email protected]"
'RemoveThis.Add "[email protected]"
If Not Item Is Nothing Then
Set oReply = Item.ReplyAll
oReply.Display
End If


Dim Recipients As Outlook.Recipients
Dim R As Outlook.Recipient
Dim i&,y&

Set Recipients = oReply.Recipients
For i = Recipients.Count To 1 Step -1
    Set R = Recipients.Item(i)

    'For y = 1 To RemoveThis.Count
        'If LCase$(R.Address) = LCase$(RemoveThis(y)) Then
        If LCase$(R.Name) Like "*msc*" Or LCase$(R.Name) Like "*eg195*" Then
            Recipients.Remove i
            'Exit For
        End If
    'Next
Next
Set oReply = Nothing
Set Item = Nothing
End Sub

代码打开一个“回复所有人”的消息，我的所有同事都从“TO”或“CC”中删除它工作正常，但我只需要在删除其他同事后在 CC 行中添加 2 个收件人“我的经理”。

有人可以帮忙吗？

解决方法

暂无找到可以解决该程序问题的有效方法，小编努力寻找整理中！

如果你已经找到好的解决方法，欢迎将解决方案带上本链接一起发送给小编。

小编邮箱:dio#foxmail.com (将#修改为@）

add cc