VBA Email as PDF

[j4ymf]

Good morning

Ive come across this VBA to send a worksheet as a pdf.
How would i change the code to add in a range to send as the email.

Source = Range("A1:K38")

mank thanks

Sub Email_From_Excel_Basic()
    Dim emailApplication As Object
    Dim emailItem As Object
    Dim strPath As String
    ' Build the PDF file name
    strPath = ActiveWorkbook.Path & Application.PathSeparator & "Sheet1.pdf"
    ' Export workbook as PDF
    Worksheets("Sheet1").ExportAsFixedFormat xlTypePDF, strPath
    Set emailApplication = CreateObject("Outlook.Application")
    Set emailItem = emailApplication.CreateItem(0)
    ' Now we build the email.
    emailItem.To = "*** Email address is removed for privacy ***"
    emailItem.Subject = "Subject line for the email."
    emailItem.Body = "The message for the email."
    ' Attach the PDF file
    emailItem.Attachments.Add strPath
    ' Send the Email
    ' Use this OR .Display, but not both together.
    emailItem.Send
    ' Display the Email so the user can change it as desired before sending it
    ' Use this OR .Send, but not both together.
    'emailItem.Display
    Set emailItem = Nothing
    Set emailApplication = Nothing
    ' Delete the PDF file
    Kill strPath
End Sub

 

[Sanjeev1976]

Modify the line :

Worksheets("Sheet1").ExportAsFixedFormat xlTypePDF, strPath

With this :

Sheets("Sheet1").Range("A1:K38").ExportAsFixedFormat xlTypePDF, strPath

 

[j4ymf]

Thank you Sanjeev1976

Thats great

Just one problem my sheet is set to 50% because of the data, how can i set it to set the print range first or scale the PFP to be 50%

thank you

 

[Sanjeev1976]

You can add the below code before the print to pdf code :

    With ActiveSheet.PageSetup
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    End With

 

[j4ymf]

thank you Sanjeev1976

have i got it in the right place as its not working

Sub Email_From_Excel_Basic()
    
    Dim emailApplication As Object
    Dim emailItem As Object
    Dim strPath As String
    ' Build the PDF file name
    strPath = ActiveWorkbook.Path & Application.PathSeparator & "PFP Labour Planner.pdf"
    ' Export workbook as PDF
      With ActiveSheet.PageSetup
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    End With
    Sheets("Report").Range("A1:K38").ExportAsFixedFormat xlTypePDF, strPath
    Set emailApplication = CreateObject("Outlook.Application")
    Set emailItem = emailApplication.CreateItem(0)
    ' Now we build the email.
    emailItem.To = "jason@pfpdefined.com"
    emailItem.Subject = "PFP Weekly Labour Planner"
    emailItem.Body = "Please find attached latest Labour Planner."
    ' Attach the PDF file
    emailItem.Attachments.Add strPath
    ' Send the Email
    ' Use this OR .Display, but not both together.
    emailItem.Send
    ' Display the Email so the user can change it as desired before sending it
    ' Use this OR .Send, but not both together.
    'emailItem.Display
    Set emailItem = Nothing
    Set emailApplication = Nothing
    ' Delete the PDF file
     MsgBox "A PDF of the Labour Planner has been emailed"
    
    Kill strPath
End Sub

 

[Sanjeev1976]

You can try the below updated code :

Sub Email_From_Excel_Basic()
    
    Dim emailApplication As Object
    Dim emailItem As Object
    Dim strPath As String
    ' Build the PDF file name
    strPath = ActiveWorkbook.Path & Application.PathSeparator & "PFP Labour Planner.pdf"
    ' Export workbook as PDF
    
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.590551181102362)
        .RightMargin = Application.InchesToPoints(0.196850393700787)
        .TopMargin = Application.InchesToPoints(0.393700787401575)
        .BottomMargin = Application.InchesToPoints(0.393700787401575)
        .HeaderMargin = Application.InchesToPoints(0.31496062992126)
        .FooterMargin = Application.InchesToPoints(0.31496062992126)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlPortrait
        .Draft = False
        .PaperSize = xlPaperLetter
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
    
    Sheets("Report").Range("A1:K38").ExportAsFixedFormat xlTypePDF, strPath
    Set emailApplication = CreateObject("Outlook.Application")
    Set emailItem = emailApplication.CreateItem(0)
    ' Now we build the email.
    emailItem.To = "jason@pfpdefined.com"
    emailItem.Subject = "PFP Weekly Labour Planner"
    emailItem.Body = "Please find attached latest Labour Planner."
    ' Attach the PDF file
    emailItem.Attachments.Add strPath
    ' Send the Email
    ' Use this OR .Display, but not both together.
    emailItem.Send
    ' Display the Email so the user can change it as desired before sending it
    ' Use this OR .Send, but not both together.
    'emailItem.Display
    Set emailItem = Nothing
    Set emailApplication = Nothing
    ' Delete the PDF file
     MsgBox "A PDF of the Labour Planner has been emailed"
    
    Kill strPath
    
End Sub

 

[j4ymf]

Thank you Sanjeev1976

Thats fantastic, thank you

all you help has been apprichated.