Vba 如何抄送发件人？

我有代码发送电子邮件。我正在努力抄送发件人？如果我发邮件，我应该得到抄送，如果我的同事发邮件，他应该得到抄送

我们的用户名不是firstname.lastname，而是电子邮件地址

Sub SendPDF()

Dim strPath As String, strFName As String
Dim OutApp As Object, OutMail As Object

Title = Format(Now(), "dd/mm/yyyy") & " - " & ActiveSheet.Name & ""

strPath = Environ$("temp") & "\" 'Or any other path, but include trailing "\"

strFName = ActiveWorkbook.Name
strFName = Format(Now(), "yyyymmdd") & " - " & ActiveSheet.Name & ".pdf"

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    strPath & strFName, Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
    .To = "firstname.surname@email.com"
    .CC = ""
    .BCC = ""
    .Subject = Title
    .body = "Please see attached"
    .Attachments.Add strPath & strFName
    '.Display
    .Send
End With

Kill strPath & strFName
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing
End Sub

您可以使用Namespace类的属性将当前登录的用户作为收件人对象获取。然后可以获取表示收件人电子邮件地址的属性值

.CC = nameSpace.CurrentUser.Address;

---

你也会发现这篇文章很有帮助

你到底需要什么？…如果不清楚，很抱歉。我想让上面的脚本抄送from address示例：如果我提交了上面的脚本，它也会抄送回我。你在那里尝试过抄送邮件地址吗？```。CC=”yourmail@mail.com“`是的，但是将会有多个用户从这个Hi Eugene发送，我无法让它工作。它只是将CC字段留空。CC=nameSpace.CurrentUser.AddressEntry.Address；尝试探索CurrentUser的AddressEntry。请注意，上述内容可能会导致有关“代表发送”的安全警告，欢迎使用SO！请添加解释性文本，说明这解决问题的原因。有关高质量的回答，请参阅。

Sub email()
    Dim a As Integer
    Dim objOutlook As Object
    Dim objMail As Object
    Dim rngTo As Range
    Dim rngCc As Range
    Dim rngBcc As Range
    Dim rngSubject As Range
    Dim rngAttach As Range
    Dim rngBody As Range

    Set objOutlook = CreateObject("Outlook.Application")
    Set objMail = objOutlook.CreateItem(0)

    With ActiveSheet
        Set rngTo = .Range("B1")
        Set rngCc = .Range("B2")
        Set rngBcc = .Range("B3")
        Set rngSubject = .Range("B4")
        Set rngAttach = .Range("B5")
        Set rngBody = .Range("B6")

    End With

    With objMail
        .To = rngTo.Value
        .Cc = rngCc.Value
        .Bcc = rngBcc.Value
        .Subject = rngSubject.Value
        .Attachments.Add rngAttach.Value
        .Body = rngBody.Value
        .Display
    End With

    Set objOutlook = Nothing
    Set objMail = Nothing
    Set rngTo = Nothing
    Set rngCc = Nothing
    Set rngBcc = Nothing
    Set rngSubject = Nothing
    Set rngAttach = Nothing
    Set rngBody = Nothing
End Sub