input error with code? PDF & email 2 sheets to Outlook

[dngsullivan]

Hi,

I have copied the code from https://www.myonlinetraininghub.com...om-excel-worksheet-then-email-it-with-outlook and adapted based on their comments.
The code is to send our quote sheet to email. I can get it working with sending 1 active sheet, however trying to add a 2nd sheet to the PDF hasn't worked. (Active sheet is Client Letter, 2nd sheet is Client Breakdown, there are many other sheets on the workbook that I do not want to send). I have a manual way around it for now (highlighting both sheets before hitting the send quote button, however would like it built into the macro.
Thanks

could you please help out with this bit:

 Dim SheetName As String
  SheetName = Application.InputBox("Type the name of the Sheet to be emailed!")
  On Error Resume Next
  ThisWorkbook.Worksheets(SheetName).Activate
  If Err.Number <> 0 Then Exit Sub
  On Error GoTo 0[/code]

here is the entire code:

	
	
	
	
	
	



	
	

		
 Option Explicit
 
Sub create_and_email_pdf()
' Author - Philip Treacy  ::   https://www.linkedin.com/in/philiptreacy
' https://www.MyOnlineTrainingHub.com...om-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 = "Jensen & Row Quote "   'Change this to change the subject of the email. The current month is added to end of subj line
    OpenPDFAfterCreating = True    '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 = Range("Client_Email").Value   'Change this if you want to specify To email e.g. ActiveSheet.Range("H1") to get email from cell H1
    Email_CC = ""
    Email_BCC = ""
Dim SheetName As String, i As Byte
 On Error Resume Next
 For i = 1 To 2
 SheetName = Application.InputBox("Client Breakdown")
 ThisWorkbook.Worksheets(SheetName).Activate
 If Err.Number = 0 Then create_and_email_pdf
 Err.Clear
 Next i
 On Error GoTo 0
            
' ******************************************************
     
    '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("C17").Value, InStr(1, ActiveSheet.Range("C17").Value, " ") + 1)
     
    'Create new PDF file name including path and file extension
    'PDFFile = DestFolder & Application.PathSeparator & ActiveSheet.Name _
    '           & "_" & CurrentMonth & ".pdf"
    
    PDFFile = CStr(ThisWorkbook.Path & "" & "Quote " & Range("C17").Value & ".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 & Range("C17").Value
        .Attachments.Add PDFFile
                 
        If DisplayEmail = False Then
             
            .Send
             
        End If
         
    End With
     
  
End Sub
	

 

[John_w]

I can get it working with sending 1 active sheet, however trying to add a 2nd sheet to the PDF hasn't worked. (Active sheet is Client Letter, 2nd sheet is Client Breakdown, there are many other sheets on the workbook that I do not want to send).

Replace the ExportAsFixedFormat line with:

    Dim currentSheet As Worksheet
    With ThisWorkbook
        Set currentSheet = .ActiveSheet
        .Worksheets(Array("Client Letter", "Client Breakdown")).Select
        .ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, OpenAfterPublish:=OpenPDFAfterCreating
        currentSheet.Select
    End With

 

[dngsullivan]

Replace the ExportAsFixedFormat line with:

    Dim currentSheet As Worksheet
    With ThisWorkbook
        Set currentSheet = .ActiveSheet
        .Worksheets(Array("Client Letter", "Client Breakdown")).Select
        .ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, OpenAfterPublish:=OpenPDFAfterCreating
        currentSheet.Select
    End With

That is amazing! thank you so much John. greatly appreciated