Excel VBA to email multiple worksheets as PDFs

[Jemini Jimi]

I have been trying to revise this code to send multiple worksheets as PDFs with no success.
The worksheets are "Sheet4", "Sheet6", and "Sheet7".
What do I need to change?
I got this code from here Author: Siluvia

Sub Save_As_PDF_Send()
Dim xSht As Worksheet
Dim xFileDlg As FileDialog
Dim xFolder As String
Dim xYesorNo As Integer
Dim xOutlookObj As Object
Dim xEmailObj As Object
Dim xUsedRng As Range

Set xSht = ActiveSheet
Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

If xFileDlg.Show = True Then
   xFolder = xFileDlg.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
xFolder = xFolder + "\" + xSht.Name + ".pdf"

'Check if file already exist
If Len(Dir(xFolder)) > 0 Then
    xYesorNo = MsgBox(xFolder & " already exists." & vbCrLf & vbCrLf & "Do you want to overwrite it?", _
                      vbYesNo + vbQuestion, "File Exists")
    On Error Resume Next
    If xYesorNo = vbYes Then
        Kill xFolder
    Else
        MsgBox "If existing PDF is not overwriten, this process will STOP." _
                    & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Exiting Macro"
        Exit Sub
    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

Set xUsedRng = xSht.UsedRange
If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Then
    'Save as PDF file
    xSht.ExportAsFixedFormat Type:=xlTypePDF, FileName:=xFolder, Quality:=xlQualityStandard
    
    'Create Outlook email
    Set xOutlookObj = CreateObject("Outlook.Application")
    Set xEmailObj = xOutlookObj.CreateItem(0)
    With xEmailObj
        .Display
        .To = ""
        .CC = ""
        .Subject = xSht.Name + ".pdf"
        .Attachments.Add xFolder
        If DisplayEmail = False Then
            '.Send
        End If
    End With
Else
  MsgBox "The active worksheet cannot be blank"
  Exit Sub
End If
End Sub

 

[DanteAmor]

Hi and welcome to MrExcel forum!

Try this:

Sub Save_As_PDF_Send()
  Dim xFolder As String
  
  With Application.FileDialog(msoFileDialogFolderPicker)
    If .Show <> -1 Then
       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
    xFolder = .SelectedItems(1)
  End With
  
  'Save as PDF file
  xFolder = xFolder & "\" & "multiple worksheets.pdf"
  Sheets(Array("Sheet4", "Sheet6", "Sheet7")).Select
  ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=xFolder, Quality:=xlQualityStandard
  
  'Create Outlook email
  With CreateObject("Outlook.Application").CreateItem(0)
    .To = "example@gmail.com"
    .CC = ""
    .Subject = "multiple worksheets.pdf"
    .Attachments.Add xFolder
    .Display
  End With
  Sheets(1).Select
End Sub

 

[Jemini Jimi]

The code stops here

  Sheets(Array("Sheet4", "Sheet6", "Sheet7")).Select

 

[DanteAmor]

The code stops here

It is not enough to say "stop here".

What does the error message say?

Do sheets "Sheet4", "Sheet6" and "Sheet7" actually exist in your book?

Change on that line to the actual names of your sheets.

 

[Jemini Jimi]

Sorry about that. Error - Run-time error '9': Subscript out of range.
I can not change it to the "actual name" because the name will continually change.

 

[RoryA]

Welcome to the MrExcel Message Board!

Cross-posting (posting the same question in more than one forum) is not against our rules, but the method of doing so is covered by #13 of the Forum Rules.

Be sure to follow & read the link at the end of the rule too!

Cross posted at:

Welcome to Experts Exchange

www.experts-exchange.com

There is no need to repeat the link(s) provided above but if you have posted the question at other places, please provide links to those as well.

If you do cross-post in the future and also provide links, then there shouldn’t be a problem.

 

[DanteAmor]

I have been trying to revise this code to send multiple worksheets as PDFs with no success.
The worksheets are "Sheet4", "Sheet6", and "Sheet7".
What do I need to change?

But in your original post you mentioned that they are sheets 4, 6 and 7.
You didn't mention that the names of the sheets are going to change.
It's impossible for us to guess if you don't explain it.


I ask you to do the test with sheets 4, 6 and 7. Just so you can verify that 3 sheets are actually saved in the PDF.

After you confirm to me that the macro works, then if you require an update to the macro to consider changing the names of the sheets, you must explain what pattern to consider to take 3 sheets.

For example, if you want to save the first 3 sheets in PDF, regardless of the name, then change this line:

Sheets(Array("Sheet4", "Sheet6", "Sheet7")).Select

For this:

Sheets(Array(1, 2, 3)).Select

 

[Jemini Jimi]

Hi RoryA , I am new here and did not know about the "Cross-posting" rule. Forgive me.

Hi Danta, Yes i did say that about the worksheet names because that is what the "codename" is and that will not change.
I am still getting the same error as before when I change the Array to 4, 6, 7.
Thank you for your help.

 

[DanteAmor]

Yes i did say that about the worksheet names because that is what the "codename" is and that will not change.

Where?

I am still getting the same error as before when I change the Array to 4, 6, 7.

I don't understand what you put in the code.

I asked you to put this:

Sheets(Array("Sheet4", "Sheet6", "Sheet7")).Select

Or this:

Sheets(Array(1, 2, 3)).Select

If you don't follow the instructions correctly, no macro will work.