Page 1 of 2 1 2 LastLast
Results 1 to 10 of 13

Thread: Mail every worksheet with address in A1

  1. #1
    Guest sknight22's Avatar
    Join Date
    Dec 2017
    Posts
    6
    Articles
    0
    Excel Version
    Excel 2016

    Mail every worksheet with address in A1



    Register for a FREE account, and/
    or Log in to avoid these ads!

    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

  2. #2
    Super Moderator Pecoflyer's Avatar
    Join Date
    Oct 2011
    Location
    Brussels Belgium
    Posts
    1,458
    Articles
    0
    Excel Version
    2010 on Xubuntu
    The lionk you added has a link to http://www.rondebruin.nl/win/s1/outlook/tips.htm

    Perhaps the paragraph
    "Copy the cells as values"

    might help

    Perhaps Ron's addin is the easiest way
    (I can't use it being on Linux)
    Thank you Ken for this secure forum.

  3. #3
    Conjurer Logit's Avatar
    Join Date
    Nov 2016
    Posts
    189
    Articles
    0
    Excel Version
    2007
    .
    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

  4. #4
    Guest sknight22's Avatar
    Join Date
    Dec 2017
    Posts
    6
    Articles
    0
    Excel Version
    Excel 2016
    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 Pecoflyer; 2018-05-16 at 04:44 PM. Reason: Removed unnecessary quote

  5. #5
    Conjurer Logit's Avatar
    Join Date
    Nov 2016
    Posts
    189
    Articles
    0
    Excel Version
    2007
    .
    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

  6. #6
    Guest sknight22's Avatar
    Join Date
    Dec 2017
    Posts
    6
    Articles
    0
    Excel Version
    Excel 2016
    Oh, my apologies.

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

    Thanks again

    Stephen

  7. #7
    Conjurer Logit's Avatar
    Join Date
    Nov 2016
    Posts
    189
    Articles
    0
    Excel Version
    2007
    No problem.

    You are welcome.

  8. #8
    Guest sknight22's Avatar
    Join Date
    Dec 2017
    Posts
    6
    Articles
    0
    Excel Version
    Excel 2016
    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

  9. #9
    Conjurer Logit's Avatar
    Join Date
    Nov 2016
    Posts
    189
    Articles
    0
    Excel Version
    2007
    .
    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 by Logit; 2018-05-16 at 04:13 PM.

  10. #10
    Super Moderator Pecoflyer's Avatar
    Join Date
    Oct 2011
    Location
    Brussels Belgium
    Posts
    1,458
    Articles
    0
    Excel Version
    2010 on Xubuntu
    @sknight
    Please do not quote entire posts unnecessarily. They make the thread hard to read, especially when containing large code chunks.
    Thank you
    Thank you Ken for this secure forum.

Page 1 of 2 1 2 LastLast

Posting Permissions

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