Results 1 to 2 of 2

Thread: Printing sheets to PDF and attaching to an email.
Thanks Thanks: 0 Likes Likes: 0

  1. #1
    New Member
    Join Date
    Aug 2017
    Location
    Oregon
    Posts
    12
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Printing sheets to PDF and attaching to an email.

    FIRST: I am an extreme novice using Macros so if you choose to assist me please try and talk at my level (thanks).

    CURRETLY: I found this macro a while back while searching and it does everything perfect for me. It attaches all my sheets to a single pdf and automatically emails to the person I need it to.

    NEEDED: I now need it to print each sheet to its own PDF with the name of the sheet and attach all PDFs to the email.

    Following is the code that is being used:

    CODE:
    Sub Email_ActiveSheet_As_PDF()


    'Do not forget to change the email ID
    'before running this code


    Dim OlApp As Object
    Dim NewMail As Object
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim FileFullPath As String


    With Application
    .ScreenUpdating = False
    .EnableEvents = False
    End With


    ' Temporary file path where pdf
    ' file will be saved before
    ' sending it in email by attaching it.


    TempFilePath = Environ$("temp") & ""


    ' Now append a date and time stamp
    ' in your pdf file name. Naming convention
    ' can be changed based on your requirement.


    TempFileName = "PDF DRAFT Invoices" & "-" & Format(Now, "dd-mmm-yy") & ".pdf"


    'Complete path of the file where it is saved
    FileFullPath = TempFilePath & TempFileName


    'Now Export the Activesshet as PDF with the given File Name and path


    On Error GoTo err
    With ActiveWorkbook
    .ExportAsFixedFormat _
    Type:=xlTypePDF, _
    FileName:=FileFullPath, _
    Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, _
    OpenAfterPublish:=False
    End With


    'Now open a new mail


    Set OlApp = CreateObject("Outlook.Application")
    Set NewMail = OlApp.CreateItem(0)


    On Error Resume Next
    With NewMail
    .To = "name@xxx.com"
    .CC = "name@xxx.com"
    .BCC = ""
    .Subject = "Draft Invoices"
    .Body = "Michelle, I have attached this months DRAFT invoices for your review and processing."
    .Attachments.Add FileFullPath '--- full path of the pdf where it is saved
    .Send 'or use .Display to show you the email before sending it.
    End With
    On Error GoTo 0


    'Since mail has been sent with the attachment
    'Now delete the pdf file from the temp folder


    Kill FileFullPath


    'set nothing to the objects created
    Set NewMail = Nothing
    Set OlApp = Nothing


    'Now set the application properties back to true
    With Application
    .ScreenUpdating = True
    .EnableEvents = True
    End With
    MsgBox ("Make sure that Outlook is open and your email with attachment will be sent")

    Exit Sub
    err:
    MsgBox err.Description


    End Sub

  2. #2
    Board Regular
    Join Date
    Nov 2008
    Location
    Netherlands
    Posts
    3,463
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    1 Thread(s)

    Default Re: Printing sheets to PDF and attaching to an email.

    Hi desnyder,

    please use code tags when posting code (see in red below)

    this should do the trick:
    Code:
    Sub Email_ActiveSheet_As_PDF()
    
    
        'Do not forget to change the email ID
        'before running this code
        
        
        Dim OlApp As Object
        Dim NewMail As Object
        Dim TempFilePath As String
        Dim TempFileName As String
        Dim FileFullPath As String
        Dim wsWS As Worksheet
        
        
        With Application
            .ScreenUpdating = False
            .EnableEvents = False
        End With
        
        
        ' Temporary file path where pdf
        ' file will be saved before
        ' sending it in email by attaching it.
        
        
        TempFilePath = Environ$("temp") & ""
        
        
        
        
        'Now Export each sheet as PDF with the given File Name and path
        'loop through all the sheets
        
        On Error GoTo err
        For Each wsWS In ActiveWorkbook.Sheets
            With wsWS
                ' Create pdf name
                TempFileName = .Name & ".pdf"
                'Complete path of the file where it is saved
                FileFullPath = TempFilePath & TempFileName
                'create the .pdf
                .ExportAsFixedFormat _
                        Type:=xlTypePDF, _
                        Filename:=FileFullPath, _
                        Quality:=xlQualityStandard, _
                        IncludeDocProperties:=True, _
                        IgnorePrintAreas:=False, _
                        OpenAfterPublish:=False
            End With
        Next wsWS
        
        'Now open a new mail
        
        
        Set OlApp = CreateObject("Outlook.Application")
        Set NewMail = OlApp.CreateItem(0)
        
        
        On Error Resume Next
        With NewMail
            .To = "name@xxx.com"
            .CC = "name@xxx.com"
            .BCC = ""
            .Subject = "Draft Invoices"
            .Body = "Michelle, I have attached this months DRAFT invoices for your review and processing."
            '~~> *.* for all files
            TempFileName = Dir(TempFilePath & "*.*")
    
            Do While Len(TempFileName) > 0
                .Attachments.Add TempFilePath & TempFileName
                TempFileName = Dir
            Loop
            .Send 'or use .Display to show you the email before sending it.
        End With
        On Error GoTo 0
        
        
        'Since mail has been sent with the attachment
        'Now delete the pdf files from the temp folder
        
        
        Kill TempFilePath & "*.pdf"
        
        
        'set nothing to the objects created
        Set NewMail = Nothing
        Set OlApp = Nothing
        
        
        'Now set the application properties back to true
        With Application
            .ScreenUpdating = True
            .EnableEvents = True
        End With
        MsgBox ("Make sure that Outlook is open and your email with attachment will be sent")
        
        Exit Sub
    err:
        MsgBox err.Description
    
    
    End Sub
    Short Guide to Better VBA - Link: https://www.mrexcel.com/forum/showthread.php?t=712119

    Please use code tags around your code:
    [Code] Your code here... [/Code]




    Engelse lessen, persoonlijk en doelgericht. Dutch tuition tailor-made for you. https://Ennef.nl

    Wearable for people with panic attacks: sidjup https://sidjup.com

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •