[PDFUtil, EmailUtil] Please add this macro
Closed this issue · 0 comments
adrielyeung commented
Sub GenPDFAndEmail()
'
' GenPDFAndEmail Sub
' Export the ActiveSheet of ActiveWorkbook as PDF,
' then create Outlook email with parameters, ready for send
'
Dim ObjOutlook As Object, ObjEmail As Object
Dim PdfName As String
' Export as PDF
PdfName = GenPDF("<Suffix>")
' Create Outlook object
Set ObjOutlook = CreateObject("Outlook.Application")
' Create email object
Set ObjEmail = ObjOutlook.CreateItem(olMailItem)
' Set parameters
With ObjEmail
.To = ""
.Cc = ""
.Subject = ""
.Body = "Dear ," & vbNewLine & vbNewLine & _
"Attached please find my <document>."
' & ObjEmail.Body - to insert text signature directly
.Attachments.Add (PdfName)
.Display ' Display the message in Outlook.
' Move to end of email to insert default signature manually
SendKeys "^+{END}", True
SendKeys "{END}", True
SendKeys "{NUMLOCK}"
End With
' Clear objects at end
Set ObjEmail = Nothing
Set ObjOutlook = Nothing
End Sub
Function GenPDF(Suffix As String) As String
'
' GenPDF Function
' Export the ActiveSheet of ActiveWorkbook as PDF,
' allowing for addition of suffix to the end of file name
'
'
GenPDF = ActiveWorkbook.Path & "\" & Left(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, ".") - 1) & "_" & Suffix & ".pdf"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=GenPDF, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=False
End Function