How to CC the sender? - vba

Question

I have code to send email. I'm struggling to CC the sender? If I mail I should get the CC, if my colleague mails he should get the CC.
Our usernames aren't firstname.lastname but our email addresses are.
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

Answer 1

You can use the CurrentUser property of the Namespace class to get the currently logged-on user as a Recipient object. Then you can get the Address property value which representing the e-mail address of the Recipient.
.CC = nameSpace.CurrentUser.Address;
Also you may find the How To: Fill TO,CC and BCC fields in Outlook programmatically article helpful.

Answer 2

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

Answer 3

I know this is kind of old, but I ended up here, so someone else might!
I was able to get the sender CC'd using the namespace (at least in an exchange environment). In my case, the CurrentUser. The address returned a string like the following:
/o=ExchangeLabs/ou=Exchange Administrative Group (XXXXXXXXXXXXXXXX)/cn=Recipients/cn=XXXXXXXXXXXXXXXXXXXXXXXXXXXXX-XXXXXXX
This was resolved successfully, and successfully CC'd the sender.
Might also look at Get sender's email address with Excel VBA
Sub TestCC()
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim OutNS As Outlook.Namespace
' Get open Outlook, or create a new instance
On Error Resume Next
Set OutApp = GetObject(, "Outlook.Application")
If OutApp Is Nothing Then Set OutApp = CreateObject("Outlook.Application")
On Error GoTo 0
' Get MAPI Namespace
Set OutNS = OutApp.GetNamespace("MAPI")
' Create Mail Item
Set OutMail = OutApp.CreateItem(olMailItem) 'Item type 0
' Build email
On Error Resume Next
With OutMail
.To = "first.last#email.com"
.CC = OutNS.CurrentUser.Address
.BCC = ""
.Subject = "Email Subject Line"
.Body = "Body Text"
' Resolve added recipients
.Recipients.ResolveAll
' Display or Send created email
.Display
'.Send
End With
' Clean up
Set OutMail = Nothing
Set OutNS = Nothing
Set OutApp = Nothing
End Sub