Excel to email PDF page of spreadsheet

S

sassriverrat

Well-known Member
Joined
Oct 4, 2018
Messages
655
I have excel and I have outlook (on the physical computer). I have a button that I made that saves/archives/quits the workbook. Is it possible to have excel make a pdf of the active page and have it email out via outlook to a series of specified emails (emails to be specified on another page in a series of specific cells (each cell is a different email- let's say A1:A3 for the sake of the argument.

Thanks!
 

Excel Facts

How to create a cell-sized chart?
Tiny charts, called Sparklines, were added to Excel 2010. Look for Sparklines on the Insert tab.
Sort by date Sort by votes
Ok so I took the code from the other sheet and started tweaking it. I'm a little stuck though about how to proceed (assuming I've done everything up to this point correctly.....

email addresses are NOT on the activesheet....they are on the "Notes" tab (which is generally hidden in the workbook-but not that the visibility matters). Would like to make the subject line and body editable...thus they are equal to a cell. Thanks for looking!
Code: 
Sub Mail_Every_Worksheet()


    Dim wb As Workbook
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim OutApp As Object
    Dim OutMail As Object
    Dim emailAddress1 As String
    Dim emailAddress2 As String
    Dim emailAddress3 As String
    Dim emailAddress4 As String
    Dim emailAddress5 As String
    Dim emailAddress6 As String
    Dim emailAddress7 As String
    Dim emailAddress8 As String
    Dim emailAddress9 As String
    Dim emailAddress10 As String
    Msgbody = Sheets("Notes").Range("A13").Value
    msgsub = Sheets("Notes").Range("A12").Value
    emailAddress1 = Sheets("Notes").Range("A1").Value
    emailAddress2 = Sheets("Notes").Range("A2").Value
    emailAddress3 = Sheets("Notes").Range("A3").Value
    emailAddress4 = Sheets("Notes").Range("A4").Value
    emailAddress5 = Sheets("Notes").Range("A5").Value
    emailAddress6 = Sheets("Notes").Range("A6").Value
    emailAddress7 = Sheets("Notes").Range("A7").Value
    emailAddress8 = Sheets("Notes").Range("A8").Value
    emailAddress9 = Sheets("Notes").Range("A9").Value
    emailAddress10 = Sheets("Notes").Range("A10").Value
    
    
    
    
    TempFilePath = Environ$("temp") & "\"
        FileExtStr = ".xlsm": FileFormatNum = 52
    End If
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    Set OutApp = CreateObject("Outlook.Application")


'how to tweak these lines......
    With ThisWorkbook.ActiveSheet
        If .Range("G14").Value Like "?*@?*.?*" Then
            emailAddress = .Range("G14").Value


            TempFileName = TempFilePath & .Name & " " & ThisWorkbook.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss") & ".pdf"
            
            .ExportAsFixedFormat Type:=xlTypePDF, Filename:=TempFileName, _
                Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False


            Set OutMail = OutApp.CreateItem(0)


            On Error Resume Next
            With OutMail
                .To = emailAddress
                .CC = ""
                .BCC = ""
                .Subject = "Engine Quote"
                .Body = "Here is the engine quote you requested. Please call with any questions. Thank you!"
                .Attachments.Add TempFileName
                .Send
            End With
            On Error GoTo 0
            
            Set OutMail = Nothing


            Kill TempFileName


        End If
    End With
    
    Set OutApp = Nothing
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub
 
Upvote 0
.
Here is a project I already had that should accomplish your goal.

You will need to edit this line in the macro : For Each c In Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row).Cells to For Each c In Sheets("Notes").Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row).Cells


Place your commandbutton on the active sheet instead of the NOTES tab.
Make certain your NOTES tab layout is identical to the example shown in this workbook EMAIL sheet.
Also, you will need to create a folder on your desktop named PDFs or add code to the macro to create the folder for you.

Code: 
Option Explicit


Sub pdf()
Dim wsA As Worksheet, wbA As Workbook, strTime As String
Dim strName As String, strPath As String
Dim strFile As String
Dim strPathFile As String




'On Error GoTo errHandler


    Set wbA = ActiveWorkbook
    Set wsA = ActiveSheet
    


'replace spaces and periods in sheet name
    strName = Replace(wsA.Name, " ", "")
    strName = Replace(strName, ".", "_")
    
'create default name for savng file
    
    strPath = Environ("UserProfile") & "\Desktop\PDFs\"
    strFile = Sheets("Email").Range("B2").Value
    strPathFile = strPath & strFile




Dim myFolder$
myFolder = "PDFs"
    
    If Dir(myFolder, vbDirectory) = "" Then
         MkDir myFolder
    End If


'export to PDF if a folder was selected
    wsA.ExportAsFixedFormat 0, strPathFile
    
    If Len(Dir$(myFolder)) > 0 Then
        SetAttr myFolder, vbNormal
    End If


'confirmation message with file info
    MsgBox "PDF file has been created: " _
      & vbCrLf _
      & strPathFile


Mail_workbook_Outlook


exitHandler:
    Exit Sub
errHandler:
    MsgBox "Could not create PDF file"
    Resume exitHandler
End Sub




Sub Mail_workbook_Outlook()


    Dim c As Range
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strPath As String
    Dim FileName As String


    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    
    strPath = Environ("UserProfile") & "\Desktop\PDFs\"
    FileName = Dir(strPath & "*.*")


    'On Error Resume Next
    For Each c In Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row).Cells
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
        With OutMail
            .To = c.Value
            .CC = ""
            .BCC = ""
            .Subject = c.Offset(0, 1).Value
            .Body = c.Offset(0, 2).Value
            FileName = Dir(strPath & "*.*")
            .Attachments.Add strPath & FileName
            
            '.Send                              '<-- .Send will auto send email without review
            .Display                            '<-- .Display will show the email first for review
        End With
        'On Error GoTo 0
    Next c




    Set OutMail = Nothing
    Set OutApp = Nothing
    
   byby
      
End Sub


Sub byby()  'deletes PDF file after attaching to email
Dim folder As Object
Dim path As String
path = Environ("UserProfile") & "\Desktop\PDFs\*.*"
Set folder = CreateObject("scripting.filesystemobject")


    folder.DeleteFolder path, True


End Sub


Download workbook : https://www.amazon.com/clouddrive/share/XifMkkqAMk8odvxpDbwt1oVnKwb8KaNYA8Yz2OWh53z
 
Upvote 0
So I tweaked the code that I have: maybe because I understood it better or because I was getting a little lost- I guess on your code I could have made it to make and delete a folder each time, but this seemed more efficient to me, maybe I'm wrong.

Anyway, ideas-

1. How would I change the email addresses here efficiently so that I can put addresses in L34 to L43 (i.e. 1-10) but they don't all have to be filled (i.e. up to 10 addresses)?

2. I'd like to set the pdf being sent to be the "print area" of the activesheet. Ideas? I do have active print areas set up already for printing with vba anyway.

Thanks- Here is my current code:

Code: 
Sub Mail_Every_Worksheet1()

    Dim wb As Workbook
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim OutApp As Object
    Dim OutMail As Object
    Dim emailaddress As String


    
    If TempFilePath = Environ$("temp") & "\" Then
          FileExtStr = ".xlsm": FileFormatNum = 52
    End If
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    Set OutApp = CreateObject("Outlook.Application")
     With ThisWorkbook.ActiveSheet
        If Sheets("Notes").Range("L34").Value Like "?*@?*.?*" Then
            emailaddress = Sheets("Notes").Range("L34").Value
            TempFileName = TempFilePath & .Name & " " & ThisWorkbook.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss") & ".pdf"
            .ExportAsFixedFormat Type:=xlTypePDF, Filename:=TempFileName, _
                Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
            Set OutMail = OutApp.CreateItem(0)
            On Error Resume Next
            With OutMail
                .To = emailaddress
                .CC = ""
                .BCC = ""
                .Subject = "Engine Quote"
                .Body = "Here is the engine quote you requested. Please call with any questions. Thank you!"
                .Attachments.Add TempFileName
                .Send
            End With
            On Error GoTo 0
            Set OutMail = Nothing
            Kill TempFileName
        End If
    End With
    Set OutApp = Nothing
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub
 
Upvote 0
Try this macro. It emails the print area of the active sheet as a PDF attachment. On the Notes sheet, the email addresses should be in cells L34:L43 (one email address or none per cell), the email subject in B30 and the body text in B31.

Code: 
Public Sub Email_Print_Area_of_Active_Sheet()

    Dim OutApp As Object, OutMail As Object
    Dim emailSubject As String, bodyText As String, toEmailAddresses As String
    Dim cell As Range, printRange As Range
    Dim TempFileName As String
        
    With ThisWorkbook.Worksheets("Notes")
        emailSubject = .Range("B30").Value
        bodyText = .Range("B31").Value
        toEmailAddresses = ""
        For Each cell In .Range("L34:L43")
            If cell.Value Like "?*@?*.?*" Then toEmailAddresses = toEmailAddresses & cell.Value & ";"
        Next
    End With
    
    With ThisWorkbook.ActiveSheet
        
        TempFileName = Environ("temp") & "\" & .Name & " " & ThisWorkbook.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss") & ".pdf"
        
        Set printRange = Range(.PageSetup.PrintArea)
        
        printRange.ExportAsFixedFormat Type:=xlTypePDF, Filename:=TempFileName, _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
            
    End With

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    'On Error Resume Next
    With OutMail
        .To = Left(toEmailAddresses, Len(toEmailAddresses) - 1)
        .CC = ""
        .BCC = ""
        .Subject = emailSubject
        .Body = bodyText
        .Attachments.Add TempFileName
        .Send
    End With
    'On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing
    
    Kill TempFileName
        
End Sub
 
Upvote 0
.
Ok .. here is your macro (as much of it that could be retained) along with one additional macro that creates the pdf file and a folder on your desktop.

Code: 
Option Explicit


Global strFile As String
Sub pdf()
Dim wsA As Worksheet, wbA As Workbook, strTime As String
Dim strName As String, strPath As String
'Dim strFile As String
Dim strPathFile As String


'On Error GoTo errHandler


    Set wbA = ActiveWorkbook
    Set wsA = ActiveSheet


'replace spaces and periods in sheet name
    strName = Replace(wsA.Name, " ", "")
    strName = Replace(strName, ".", "_")
    
'create default name for savng file
    
    strPath = Environ("UserProfile") & "\Desktop\PDFs\"
    strFile = ThisWorkbook.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss") & ".pdf"
    strPathFile = strPath & strFile


Dim myFolder$
myFolder = Environ("UserProfile") & "\Desktop\PDFs"
    
    If Dir(myFolder, vbDirectory) = "" Then
         MkDir myFolder
    End If


'export to PDF if a folder was selected
    wsA.ExportAsFixedFormat 0, strPathFile
    
    If Len(Dir$(myFolder)) > 0 Then
        SetAttr myFolder, vbNormal
    End If


'confirmation message with file info
    MsgBox "PDF file has been created: " _
      & vbCrLf _
      & strPathFile
Mail_Every_Worksheet1


exitHandler:
    Exit Sub
errHandler:
    MsgBox "Could not create PDF file"
    Resume exitHandler
End Sub
Sub Mail_Every_Worksheet1()


    Dim wb As Workbook
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim TempFileName2 As String
    Dim OutApp As Object
    Dim OutMail As Object
    Dim emailaddress As String
    Dim c As Range
    
    
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    For Each c In Range("L34:L43")
    If c.Value <> "" Then
        Set OutApp = CreateObject("Outlook.Application")
         With ThisWorkbook.ActiveSheet
                TempFileName = Environ("UserProfile") & "\Desktop\PDFs\" & strFile
                'TempFileName2 = Environ("UserProfile") & "\Desktop\PDFs\*.*"
                Set OutMail = OutApp.CreateItem(0)
                On Error Resume Next
                With OutMail
                    .To = c.Value
                    .CC = ""
                    .BCC = ""
                    .Subject = "Engine Quote"
                    .Body = "Here is the engine quote you requested. Please call with any questions. Thank you!"
                    .Attachments.Add TempFileName
                    '.Send
                    .Display
                End With
                On Error GoTo 0
                Set OutMail = Nothing
               
            'End If
        End With
    End If
    Next
    Kill TempFileName
    RmDir Environ("UserProfile") & "\Desktop\PDFs"
    Set OutApp = Nothing
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

A folder named PDFs, if it does not already exist, will be created on your desktop as a temporary location to hold the PDF file. The PDF file of the active sheet is created and temporarily stored in the folder.
The email/s are created and the pdf file is attached to each of them. You can have one email address or ten addresses in the range L34:L43. If an email address exists in that range, an email will be created.
The emails are displayed on screen for you to review prior to sending. If you don't want to view the email first but rather just send it, comment out the command .Display and uncomment the command
.Send

Presently as written, the pdf created will also include the email addresses shown on sheet1. You can eliminate the addresses being included in the pdf file by :

- move the addresses to a second sheet and edit the code so it "reads" those addresses on the other sheet.
- do not use ActiveSheet in your code as it picks up everything on the sheet no matter where it is located. You could specify a particular range to be created into the pdf.
 
Upvote 0
@Logit
Going to try your code now but I'll have to tell Excel to delete the folder after done- basically because I don't want anything left over when finished.
@John_w
This is EXACTLY what I wanted! However, one issue. Code is breaking at the
Rich (BB code): 
Set printRange = Range(.PageSetup.PrintArea)

Ideas why this would happen? typical "Method 'Range' of object'_Global' failed....

Just so you know- the activesheets are created via macro and this code it to be set in a module so that a button on the activesheet being used can fire this off! The print area is created in the macro that creates the sheet. (FYI- your module is going to be set to be called when the [print] button on the activesheet is hit)
 
Upvote 0
That error could occur if you haven't set the print area on the active sheet. The code should work if you have set a single print area or multiple print areas.

Add this code immediately above the Set printRange line to display a warning if the print area hasn't been set.

Code: 
        If .PageSetup.PrintArea = vbNullString Then
            MsgBox "You must set the Print Area(s) on the '" & .Name & "' sheet.", vbExclamation
            Exit Sub
        End If
 
Upvote 0
.
The macro deletes the temp folder and pdfs after the emails have been created.
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Solved
Save outlook attachment without file extensions
Replies
3
Views
483
johnnyL
J
R
  • Question
Mail merge to insert the picture in the mail body and schedule the email
Replies
0
Views
768
rafeek4u
R
J
  • Question
Saving a sheet as a PDF and preserving links to pages in the sheet
Replies
6
Views
1K
Sabooru
S
B
  • Question
Automating Outlook Using Custom Tags in Email Templates
Replies
0
Views
366
brncao
B
T
  • Question
Open url link (in an excel cell) in the same window - target=_self.
Replies
0
Views
589
TrulsF
T

Forum statistics

Threads
1,214,944
Messages
6,122,392
Members
449,081
Latest member
JAMES KECULAH

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top