Hello,
I need to add the sender email address to the below and don't know how to; this is an excel file filled out and using the VBA is sent as a PDF; I am able to add the recipient, but don't know how to add the sender.
Also how do I had the title to the PDF file? The title is showing in the email message only.
Thank you for your help!
Sub AttachActiveSheetPDF()
Dim IsCreated As Boolean
Dim i As Long
Dim PdfFile As String, Title As String
Dim OutlApp As Object
Title = Range("b5")
PdfFile = ActiveWorkbook.FullName
i = InStrRev(PdfFile, ".")
If i > 1 Then PdfFile = Left(PdfFile, i - 1)
PdfFile = PdfFile & "_" & ActiveSheet.Name & ".pdf"
With ActiveSheet
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End With
On Error Resume Next
Set OutlApp = GetObject(, "Outlook.Application")
If Err Then
Set OutlApp = CreateObject("Outlook.Application")
IsCreated = True
End If
OutlApp.Visible = True
On Error GoTo 0
With OutlApp.CreateItem(0)
.Subject = Title
.To = "email@recipient.com" ' <-- email of the recipient here
.CC = "ABC@recipient.com " ' <-- email of 'copy to' recipient here, but don't know how to add the sender as well so he can receive a copy of the PDF
.Body = "Hi," & vbLf & vbLf _
& "New sheet is attached in PDF format." & vbLf & vbLf _
& "Regards," & vbLf _
& Application.UserName & vbLf & vbLf
.Attachments.Add PdfFile
On Error Resume Next
.Send
Application.Visible = True
If Err Then
MsgBox "E-mail was not sent", vbExclamation
Else
MsgBox "Awesome!E-mail successfully sent", vbInformation
End If
On Error GoTo 0
End With
Kill PdfFile
If IsCreated Then OutlApp.Quit
Set OutlApp = Nothing
End Sub
I need to add the sender email address to the below and don't know how to; this is an excel file filled out and using the VBA is sent as a PDF; I am able to add the recipient, but don't know how to add the sender.
Also how do I had the title to the PDF file? The title is showing in the email message only.
Thank you for your help!
Sub AttachActiveSheetPDF()
Dim IsCreated As Boolean
Dim i As Long
Dim PdfFile As String, Title As String
Dim OutlApp As Object
Title = Range("b5")
PdfFile = ActiveWorkbook.FullName
i = InStrRev(PdfFile, ".")
If i > 1 Then PdfFile = Left(PdfFile, i - 1)
PdfFile = PdfFile & "_" & ActiveSheet.Name & ".pdf"
With ActiveSheet
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End With
On Error Resume Next
Set OutlApp = GetObject(, "Outlook.Application")
If Err Then
Set OutlApp = CreateObject("Outlook.Application")
IsCreated = True
End If
OutlApp.Visible = True
On Error GoTo 0
With OutlApp.CreateItem(0)
.Subject = Title
.To = "email@recipient.com" ' <-- email of the recipient here
.CC = "ABC@recipient.com " ' <-- email of 'copy to' recipient here, but don't know how to add the sender as well so he can receive a copy of the PDF
.Body = "Hi," & vbLf & vbLf _
& "New sheet is attached in PDF format." & vbLf & vbLf _
& "Regards," & vbLf _
& Application.UserName & vbLf & vbLf
.Attachments.Add PdfFile
On Error Resume Next
.Send
Application.Visible = True
If Err Then
MsgBox "E-mail was not sent", vbExclamation
Else
MsgBox "Awesome!E-mail successfully sent", vbInformation
End If
On Error GoTo 0
End With
Kill PdfFile
If IsCreated Then OutlApp.Quit
Set OutlApp = Nothing
End Sub
Code:
&
Last edited:
