如何CC发件人?

时间:2015-02-12 11:13:53

标签: vba email outlook-vba

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

我们的用户名不是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

2 个答案:

答案 0 :(得分:1)

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

.CC = nameSpace.CurrentUser.Address;

另外,您可能会发现How To: Fill TO,CC and BCC fields in Outlook programmatically文章很有帮助。

答案 1 :(得分:0)

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