邮件自动秘密抄送自己

书架音箱

outlook 2013

如何设置, 每封邮件可以自动秘密抄送自己 ?
谢谢!

zpy2

https://jingyan.baidu.com/article/9faa7231f05878473c28cbdd.html

书架音箱

这是"手动", 不是"自动".

吾股丰登

Outlook发送邮件的核心代码，其中包含暗送部分，请参考。
Sub Example()
   
    '简单调用示例，调用中各参数分别为："收件人","抄送人","密送人","主题","正文","附件"。
    SendEmail "zhangjianshu_cqu@126.com", "", "", "jmail_free.rar", "hi,how are you !", "E:\jmail_free.rar"
   
End Sub

Sub SendEmail(To_Addr As String, Cc_Addr As String, Bcc_Addr As String, SubjectText As String, BodyText As String, AttachedObject As String)
    Dim OutlookObj As Object
    Dim OutlookNewMail As Object
   
    '创建Outlook对象
    Set OutlookObj = CreateObject("Outlook.Application")
    Set OutlookNewMail = OutlookObj.CreateItem(olMailItem)
   
    '错误异常处理
    On Error GoTo SendEmail_Failed
   
    With OutlookNewMail
        .To = To_Addr                   '收件人地址
        .cc = Cc_Addr                   '抄送人地址
        .BCC = Bcc_Addr                 '密送人地址
        .Subject = SubjectText          '邮件主题
        .Body = BodyText                '邮件内容
        .Attachments.Add AttachedObject '粘贴附件
        
        '.Send                          '若采用.Send方式发送邮件，则Outlook容易出现“有一个程序正试图以您的名义发送电子邮件”提示，比较招人讨厌。
                                        '若坚持采用此种方式发送邮件，又不想Outlook出现讨厌的提示，则需对Outlook进行如下设置：
                                        '"工具" -> "信任中心" -> "编程访问" -> 选择"从不向我发出可疑活动警告"
    End With
   
    '以下是采用通过激活Outlook，然后模拟按键方式进行邮件发送
SendEmail_Sending:   
    '显示发送邮件窗口
    OutlookNewMail.display
   
    '以下目的是留给系统充分的时间点击发送键
    For j = 1 To 200
        DoEvents
    Next
   
    '点击邮件发送
    SendKeys "%s", Wait:=True
    '遗憾的是，这里无法显示服务器发送状态，只能返回Excel发送的结果
    MsgBox "邮件已发送！"
    Exit Sub
  
SendEmail_Failed:
    MsgBox "发送失败，原因为：" & Err.Description
    Exit Sub
   
End Sub