Need Guidance and Alteration on My Own Workbook - Creating PDF and Mail

Hi cychua

Do you wish to email the entire workbook?
Where will the Email address be stored?

Hi cychua

The attached code will do as you require. Place it in a General Module. You can call the Code either by Button (assign Create_PDF to the Button) or by assigning a Key Board short cut to the Procedure. Let me know of issues.

Option Explicit
Dim myPath As String

Sub Create_PDF()
    Dim strSubject As String
    Dim strBody As String
    Dim strTo As String
    Dim strCC As String
    Dim Filename As String

    myPath = ThisWorkbook.Path & "\"
    strSubject = "Enter Your Subject Here"  '<----------------
    strBody = "Enter Your Body Message Here"  '<----------------
    strTo = ""
    strCC = ""

    Sheets("HBL").Select
    
    '*********************************
    ' This will be the Title of the PDF
    
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
            myPath & "What Ever You Wish " & Format(Date, "dd_mm_yyyy") & ".pdf" _
            , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
            :=False, OpenAfterPublish:=False
    Filename = myPath & "What Ever You Wish " & Format(Date, "dd_mm_yyyy") & ".pdf"
   '*********************************

    If Filename <> "" Then
        RDB_Mail_PDF_Outlook Filename, strTo, strCC, strSubject, strBody, False
    Else
        MsgBox "Not possible to create the PDF, possible reasons:" & vbNewLine & _
                "Microsoft Add-in is not installed" & vbNewLine & _
                "You Canceled the GetSaveAsFilename dialog" & vbNewLine & _
                "The path to Save the file in arg 2 is not correct" & vbNewLine & _
                "You didn't want to overwrite the existing PDF if it exist"
    End If
    Kill Filename
End Sub


Function RDB_Mail_PDF_Outlook(FileNamePDF As String, strTo As String, strCC As String, _
        strSubject As String, strBody As String, Send As Boolean)
    Dim OutApp As Object
    Dim OutMail As Object

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
    With OutMail
        .To = strTo
        .CC = strCC
        .BCC = ""
        .Subject = strSubject
        .Body = strBody
        .Attachments.Add FileNamePDF
        If Send = True Then
            .Send
        Else
            .Display
        End If
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
End Function

Hi cychua

I don't understand the request...please try again.

Hi cychua

Try this

Option Explicit
Dim myPath As String

Sub Create_PDF()
    Dim strSubject As String
    Dim strBody As String
    Dim strTo As String
    Dim strCC As String
    Dim Filename As String
    Dim LR As Long

    myPath = ThisWorkbook.Path & "\"
    strSubject = "Enter Your Subject Here"  '<----------------
    strBody = "Enter Your Body Message Here"  '<----------------
    strTo = ""
    strCC = ""

    Sheets("HBL").Select
    
    LR = Cells.Find("*", Cells(Rows.Count, Columns.Count), SearchOrder:=xlByRows, _
            SearchDirection:=xlPrevious).Row
    If LR < 72 Then
        With ActiveSheet.PageSetup
            .PrintArea = "A1:J64"
        End With
    Else
        With ActiveSheet.PageSetup
            .PrintArea = "A1:J118"
        End With
    End If

    '*********************************
    ' This will be the Title of the PDF
    ' Change "What Ever You Wish" to your desired name"

    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
            myPath & "What Ever You Wish " & Format(Date, "dd_mm_yyyy") & ".pdf" _
            , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
            :=False, OpenAfterPublish:=False
    Filename = myPath & "What Ever You Wish " & Format(Date, "dd_mm_yyyy") & ".pdf"
    '*********************************

    If Filename <> "" Then
        RDB_Mail_PDF_Outlook Filename, strTo, strCC, strSubject, strBody, False
    Else
        MsgBox "Not possible to create the PDF, possible reasons:" & vbNewLine & _
                "Microsoft Add-in is not installed" & vbNewLine & _
                "You Canceled the GetSaveAsFilename dialog" & vbNewLine & _
                "The path to Save the file in arg 2 is not correct" & vbNewLine & _
                "You didn't want to overwrite the existing PDF if it exist"
    End If
    Kill Filename
End Sub


Function RDB_Mail_PDF_Outlook(FileNamePDF As String, strTo As String, strCC As String, _
        strSubject As String, strBody As String, Send As Boolean)
    Dim OutApp As Object
    Dim OutMail As Object

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
    With OutMail
        .To = strTo
        .CC = strCC
        .BCC = ""
        .Subject = strSubject
        .Body = strBody
        .Attachments.Add FileNamePDF
        If Send = True Then
            .Send
        Else
            .Display
        End If
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
End Function