Mail every worksheet with address in A1

Status
Not open for further replies.

sknight22

Guest
Joined
Dec 12, 2017
Messages
6
Reaction score
0
Points
0
Excel Version(s)
Excel 2016
Hello
I am using code from the below link to send multiple sheets to email addresses in cell a1.

http://www.rondebruin.nl/win/s1/outlook/amail5.htm

I have hit a snag though. My sheets are made up of filtered pivots and I don’t want the recipient to be able to take the filter off.

Could the code be amended to first copy and paste special the whole sheet then send?

Thanks

Stephen
 
.
If you desire for the recipient to only view the sheet, perhaps converting it to a PDF format first ?

Code:
Option Explicit


Sub create_and_email_pdf()
' Author - Philip Treacy  ::   http://www.linkedin.com/in/philiptreacy
' http://www.MyOnlineTrainingHub.com/vba-to-create-pdf-from-excel-worksheet-then-email-it-with-outlook
' Date - 14 Oct 2013
' Create a PDF from the current sheet and email it as an attachment through Outlook


Dim EmailSubject As String, EmailSignature As String
Dim CurrentMonth As String, DestFolder As String, PDFFile As String
Dim Email_To As String, Email_CC As String, Email_BCC As String
Dim OpenPDFAfterCreating As Boolean, AlwaysOverwritePDF As Boolean, DisplayEmail As Boolean
Dim OverwritePDF As VbMsgBoxResult
Dim OutlookApp As Object, OutlookMail As Object
CurrentMonth = ""


' *****************************************************
' *****     You Can Change These Variables    *********


    EmailSubject = "Invoice Attached for "   'Change this to change the subject of the email. The current month is added to end of subj line
    OpenPDFAfterCreating = False    'Change this if you want to open the PDF after creating it : TRUE or FALSE
    AlwaysOverwritePDF = False      'Change this if you always want to overwrite a PDF that already exists :TRUE or FALSE
    DisplayEmail = True 'Change this if you don't want to display the email before sending.  Note, you must have a TO email address specified for this to work
    Email_To = ActiveSheet.Range("A1")  'Change this if you want to specify To email e.g. ActiveSheet.Range("H1") to get email from cell H1
    Email_CC = ""
    Email_BCC = ""
           
' ******************************************************
    
    'Prompt for file destination
    With Application.FileDialog(msoFileDialogFolderPicker)
        
        If .Show = True Then
        
            DestFolder = .SelectedItems(1)
            
        Else
        
            MsgBox "You must specify a folder to save the PDF into." & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Must Specify Destination Folder"
                
            Exit Sub
            
        End If
        
    End With


    'Current month/year stored in H6 (this is a merged cell)
    CurrentMonth = Mid(ActiveSheet.Range("H6").Value, InStr(1, ActiveSheet.Range("H6").Value, " ") + 1)
    
    'Create new PDF file name including path and file extension
    PDFFile = DestFolder & Application.PathSeparator & ActiveSheet.Name _
                & "_" & CurrentMonth & ".pdf"


    'If the PDF already exists
    If Len(Dir(PDFFile)) > 0 Then
    
        If AlwaysOverwritePDF = False Then
        
            OverwritePDF = MsgBox(PDFFile & " already exists." & vbCrLf & vbCrLf & "Do you want to overwrite it?", vbYesNo + vbQuestion, "File Exists")
        
            On Error Resume Next
            'If you want to overwrite the file then delete the current one
            If OverwritePDF = vbYes Then
    
                Kill PDFFile
        
            Else
    
                MsgBox "OK then, if you don't overwrite the existing PDF, I can't continue." _
                    & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Exiting Macro"
                
                Exit Sub
        
            End If


        Else
        
            On Error Resume Next
            Kill PDFFile
            
        End If
        
        If Err.Number <> 0 Then
        
            MsgBox "Unable to delete existing file.  Please make sure the file is not open or write protected." _
                    & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Unable to Delete File"
                
            Exit Sub
        
        End If
            
    End If

    'Create the PDF
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
        :=False, OpenAfterPublish:=OpenPDFAfterCreating


    'Create an Outlook object and new mail message
    Set OutlookApp = CreateObject("Outlook.Application")
    Set OutlookMail = OutlookApp.CreateItem(0)
        
    'Display email and specify To, Subject, etc
    With OutlookMail
        
        .Display
        .To = Email_To
        .CC = Email_CC
        .BCC = Email_BCC
        .Subject = EmailSubject & CurrentMonth
        .Attachments.Add PDFFile
                
        If DisplayEmail = False Then
            
            .Send
            
        End If
        
    End With
 
End Sub
 

Attachments

  • WORKS create-pdf-from-excel-worksheet-then-email-it-with-outlook.xlsm
    53.9 KB · Views: 18
Hello

I love this idea of a PDF - this would work perfectly.

I have noticed when I run the report it asks me to specify a folder to save it in.

In my other code it stores it in a temporary folder then deletes it automatically when sent.

is this something that can be dont with the code you supplied?

Thanks for your helpe
 
Last edited by a moderator:
.
Just a friendly "heads up" ... quoting the previous post is not required unless there is a specific reference needed to draw the reader's attention to. Including the quoted post consumes too much space on the server.

Here is an edited version of the macro that will create a 'Temp PDF' folder on the C drive, creates the PDF file as before as well as the email with the PDF attached, then deletes the temporary folder.

Code:
Option Explicit


Sub create_and_email_pdf()
' Author - Philip Treacy  ::   http://www.linkedin.com/in/philiptreacy
' http://www.MyOnlineTrainingHub.com/vba-to-create-pdf-from-excel-worksheet-then-email-it-with-outlook
' Date - 14 Oct 2013
' Create a PDF from the current sheet and email it as an attachment through Outlook


Dim EmailSubject As String, EmailSignature As String
Dim CurrentMonth As String, DestFolder As String, PDFFile As String
Dim Email_To As String, Email_CC As String, Email_BCC As String
Dim OpenPDFAfterCreating As Boolean, AlwaysOverwritePDF As Boolean, DisplayEmail As Boolean
Dim OverwritePDF As VbMsgBoxResult
Dim OutlookApp As Object, OutlookMail As Object
CurrentMonth = ""


' *****************************************************
' *****     You Can Change These Variables    *********


    EmailSubject = "Invoice Attached for "   'Change this to change the subject of the email. The current month is added to end of subj line
    OpenPDFAfterCreating = False    'Change this if you want to open the PDF after creating it : TRUE or FALSE
    AlwaysOverwritePDF = False      'Change this if you always want to overwrite a PDF that already exists :TRUE or FALSE
    DisplayEmail = True 'Change this if you don't want to display the email before sending.  Note, you must have a TO email address specified for this to work
    Email_To = ActiveSheet.Range("A1")  'Change this if you want to specify To email e.g. ActiveSheet.Range("H1") to get email from cell H1
    Email_CC = ""
    Email_BCC = ""
           
' ******************************************************
    
    'Current month/year stored in H6 (this is a merged cell)
    CurrentMonth = Mid(ActiveSheet.Range("H6").Value, InStr(1, ActiveSheet.Range("H6").Value, " ") + 1)
    DestFolder = "C:\Tmp PDF"
    
    'Create new PDF file name including path and file extension
    PDFFile = DestFolder & Application.PathSeparator & ActiveSheet.Name _
                & "_" & CurrentMonth & ".pdf"
    
    'Create the PDF
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
        :=False, OpenAfterPublish:=OpenPDFAfterCreating


    'Create an Outlook object and new mail message
    Set OutlookApp = CreateObject("Outlook.Application")
    Set OutlookMail = OutlookApp.CreateItem(0)
        
    'Display email and specify To, Subject, etc
    With OutlookMail
        
        .Display
        .To = Email_To
        .CC = Email_CC
        .BCC = Email_BCC
        .Subject = EmailSubject & CurrentMonth
        .Attachments.Add PDFFile
                
        If DisplayEmail = False Then
            
            .Send
            
        End If
        
    End With
    
    Delete_Whole_Folder
 
End Sub


Sub CteateFolder()


    Dim newObj As Object
    Application.ScreenUpdating = False
    Set newObj = CreateObject("Scripting.FileSystemObject")
    If newObj.FolderExists("C:\Tmp PDF") Then
        MsgBox "Found it.", vbInformation, "Temp Folder Located"
    Else
        newObj.CreateFolder ("C:\Tmp PDF")
        'MsgBox "It has been created.", vbInformation, "Temp Folder Created"
    End If
    Application.ScreenUpdating = True
    
    create_and_email_pdf
    
End Sub


Sub Delete_Whole_Folder()
'Delete whole folder without removing the files first
    Dim FSO As Object
    Dim MyPath As String


    Set FSO = CreateObject("scripting.filesystemobject")


    MyPath = "C:\Tmp PDF"  '<< Change


    If Right(MyPath, 1) = "\" Then
        MyPath = Left(MyPath, Len(MyPath) - 1)
    End If


    If FSO.FolderExists(MyPath) = False Then
        MsgBox MyPath & " doesn't exist"
        Exit Sub
    End If


    FSO.deletefolder MyPath


End Sub
 

Attachments

  • WORKS create-pdf-from-excel-worksheet-then-email-it-with-outlook.xlsm
    54.1 KB · Views: 22
Oh, my apologies.

Thank you for your help. I will have a go with this tomorrow at work.

Thanks again

Stephen
 
No problem.

You are welcome.
 
Hi Logit

I have just tried this code and it creates 3 macros (below)
create_and_email_pdf
CteateFolder
Delete_Whole_Folder

If i try to run the first macro i get a run time error which highlights the below part of the code in the debugger;

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=OpenPDFAfterCreating

Have I done something wrong?

Thanks

Stephen
 
.
The error lies in the macro you have chosen to run first.

In this scenario, you must run CteateFolder first. The code in that macro checks if the folder already exists. If it does then the folder doesn't need to be created and it moves on to create_and_email_pdf.
Otherwise it creates the folder first, then moves on.
 
Last edited:
@sknight
Please do not quote entire posts unnecessarily. They make the thread hard to read, especially when containing large code chunks.
Thank you
 
.
He was advised in Post #5 and responded in Post #6.

Thank you Pecoflyer.
 
Hi
yes Logit has already mentioned that earlier in the thread
 
Status
Not open for further replies.
Back
Top