Emailing as PDF instead of xlsx

[rlink_23]

so I have a sheet that I have set up to email the selected sheet when you click email. It finds the email address in "G14" and sends the email as an xlsx. I have decided I think a PDF will be a b etter format to send so that way the customer doesn't have the option to edit the sheet... I have tried Ron De Bruin's code to no avail... The current code I have looks like this

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


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


   
        FileExtStr = ".xlsm": FileFormatNum = 52
    End If


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


    Set OutApp = CreateObject("Outlook.Application")


    For Each sh In ThisWorkbook.Worksheets
        If sh.Range("G14").Value Like "?*@?*.?*" Then


            sh.Copy
            Set wb = ActiveWorkbook


            TempFileName = "Sheet " & sh.Name & " of " _
                         & ThisWorkbook.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")


            Set OutMail = OutApp.CreateItem(0)


            With wb
                .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum


                On Error Resume Next
                With OutMail
                    .To = sh.Range("G14").Value
                    .CC = ""
                    .BCC = ""
                    .Subject = "Engine Quote"
                    .Body = "Here is the engine quote you requested. Please call with any questions. Thank you!"
                    .Attachments.Add wb.FullName
                   
                    .Send   
                End With
                On Error GoTo 0


                .Close savechanges:=False
            End With
            
            Set OutMail = Nothing


            Kill TempFilePath & TempFileName & FileExtStr


        End If
    Next sh


    Set OutApp = Nothing


    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With


End Sub

Now can I use this same code just change a little bit to send as pdf? Or am I opening a whole new batch of problems? Please help???

 

[John_w]

Change the For... Next loop to:

    For Each sh In ThisWorkbook.Worksheets
        If sh.Range("G14").Value Like "?*@?*.?*" Then

            TempFileName = TempFilePath & "Sheet " & sh.Name & " of " _
                         & ThisWorkbook.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss") & ".pdf"
            
            sh.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 = sh.Range("G14").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
            End With
            On Error GoTo 0
            
            Set OutMail = Nothing

            Kill TempFileName

        End If
    Next sh

 

[rlink_23]

Joh that worked great... The only question I have is when I test the code, and sent an email to myself. It shows 1 of 1293 Sheet... I have only the one sheet that needs emailed... Is there a way to change that so it is only one sheet???? If somebody goes to print the PDF it will print all the sheets unless they know to actually only print page one! Thanks again for your help by the way!!!

 

[rlink_23]

And I meant John!!! typing so fast I didn't spell check.. lol

 

[Michael M]

If it shows as 1 of 1293 sheets....you probably have data somewhere else on the sheet.
on the sheet in question Press CTRL + END and see where the cursor ends up.
If it's way down the sheet somewhere, you will need to delete all rows / columns outside the used range

 

[John_w]

To email just the active sheet, replace my previous code with:

    Dim emailAddress As String

    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

 

[rlink_23]

That worked great!!!! Thank you very very much!!! I love it!!!!

 

[rlink_23]

Solved

 

[sassriverrat]

not to open an old thread but too late...awesome piece of code here!

Just to clarify and helpful to me:

G14 accepts any email address. I plan to tweak this to pull the email address from another sheet in my workbook (hidden sheet).
I also would like to tell it to send to all all email addresses, say G14, G15, etc to G23 (up to 10 recipients)- don't know if i'll need 10 but gives me future expansion room.

Any reason I can't tweak to set lines like .Subject = subject and subject = .Range("A1") ? Then it's easy and quick for a user to tweak.

Thanks for the input. I plan to attach this in a module with a button on the activesheet so it can be easily sent on demand! Thanks!

Also- running excel adn have outlook installed on machine. This should send through outlook without actually opening, correct?

Thanks again