adrielyeung/macro-workbook

[PDFUtil, EmailUtil] Please add this macro

Closed this issue · 0 comments

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