Saving each worksheet as individual pdf files from multiple workbooks - excel

Question

I'm trying figure out how to modify the code I came across (can be found below). So instead of it making the worksheets as pages to pdf, I would want it to make them as individual pdf files. It should ass well avoid certain list of names for example:
"pricing",
"cover" and
"important",
and it should take the name from the sheet it's making the pdf from. I'm at a dead end right now, so might as well ask.
Here's to code (This code selects the file the Excels are in, makes you choose where the pdf files go to and loops trough every worksheet in the folder (For instance i got 50 files with 3 sheets each and I need each sheet as their own pdf:s to be an attachment for an invoice)):
Sub ExcelSaveAsPDF()
Dim strPath As String
Dim xStrFile1, xStrFile2 As String
Dim xWbk As Workbook
Dim xSFD, xRFD As FileDialog
Dim xSPath As String
Dim xRPath, xWBName As String
Dim xBol As Boolean
Set xSFD = Application.FileDialog(msoFileDialogFolderPicker)
With xSFD
.Title = "Please select the folder contains the Excel files you want to "
convert:"
.InitialFileName = "C:\"
End With
If xSFD.Show <> -1 Then Exit Sub
xSPath = xSFD.SelectedItems.Item(1)
Set xRFD = Application.FileDialog(msoFileDialogFolderPicker)
With xRFD
.Title = "Please select a destination folder to save the converted files:"
.InitialFileName = "C:\"
End With
If xRFD.Show <> -1 Then Exit Sub
xRPath = xRFD.SelectedItems.Item(1) & "\"
strPath = xSPath & "\"
xStrFile1 = Dir(strPath & "*.*")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Do While xStrFile1 <> ""
xBol = False
If Right(xStrFile1, 3) = "xls" Then
Set xWbk = Workbooks.Open(Filename:=strPath & xStrFile1)
xbwname = Replace(xStrFile1, ".xls", "_pdf")
xBol = True
ElseIf Right(xStrFile1, 4) = "xlsx" Then
Set xWbk = Workbooks.Open(Filename:=strPath & xStrFile1)
xbwname = Replace(xStrFile1, ".xlsx", "_pdf")
xBol = True
ElseIf Right(xStrFile1, 4) = "xlsm" Then
Set xWbk = Workbooks.Open(Filename:=strPath & xStrFile1)
xbwname = Replace(xStrFile1, ".xlsm", "_pdf")
xBol = True
End If
If xBol Then
xWbk.ExportAsFixedFormat Type:=xlTypePDF, Filename:=xRPath & xbwname & ".pdf"
xWbk.Close SaveChanges:=False
End If
xStrFile1 = Dir
Loop
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Answer 1

Credits to U/Jimm_kirkk for helping with this project.
My original reddit Post: [Here][1]!
Code explanation:
Makes you select the folder that contains the Excel files and where the pdf files go to.
After that it makes every sheet ad individual pdf.
In the code is a place you can set a list of names to avoid printing as pdf.
Takes around a minute per 10 excel files.
The code:
Sub ExcelSaveAsPDF()
Dim strPath As String
Dim xStrFile1, xStrFile2 As String
Dim xWbk As Workbook
Dim xSFD, xRFD As FileDialog
Dim xSPath As String
Dim xRPath, xWBName As String
Dim xBol As Boolean
Set xSFD = Application.FileDialog(msoFileDialogFolderPicker)
With xSFD
.Title = "Please select the folder contains the Excel files you want to convert:"
.InitialFileName = "C:\"
End With
If xSFD.Show <> -1 Then Exit Sub
xSPath = xSFD.SelectedItems.Item(1)
Set xRFD = Application.FileDialog(msoFileDialogFolderPicker)
With xRFD
.Title = "Please select a destination folder to save the converted files:"
.InitialFileName = "C:\"
End With
If xRFD.Show <> -1 Then Exit Sub
xRPath = xRFD.SelectedItems.Item(1) & "\"
strPath = xSPath & "\"
xStrFile1 = Dir(strPath & "*.*")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Do While xStrFile1 <> ""
xBol = False
If Right(xStrFile1, 3) = "xls" Then
Set xWbk = Workbooks.Open(Filename:=strPath & xStrFile1)
'modified xbwname to be simplified name
xbwname = Replace(xStrFile1, ".xls", "")
xBol = True
ElseIf Right(xStrFile1, 4) = "xlsx" Then
Set xWbk = Workbooks.Open(Filename:=strPath & xStrFile1)
'modified xbwname to be simplified name
xbwname = Replace(xStrFile1, ".xlsx", "")
xBol = True
ElseIf Right(xStrFile1, 4) = "xlsm" Then
Set xWbk = Workbooks.Open(Filename:=strPath & xStrFile1)
'modified xbwname to be simplified name
xbwname = Replace(xStrFile1, ".xlsm", "")
xBol = True
End If
If xBol Then
'modified here to install sub main_ExportPDF()
Sheet_ExportPDF xWbk, xRPath & xbwname
''''''''''''''''''''''''''''''''''''''''''''''
xWbk.Close SaveChanges:=False
End If
xStrFile1 = Dir
Loop
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Sub Sheet_ExportPDF(wb As Workbook, fname As String)
'Purpose: determine sheets to be exported to pdf
'store base workbook name
Dim baseWB As String
baseWB = fname
'user to define what names to avoid by adding to string
Const NTA As String = "pricing,cover,important"
'build array of names to avoid
Dim NamesToAvoid As Variant
NamesToAvoid = Split(NTA, ",")
'process visible worksheets and compare to NamesToAvoid, export the
'sheets that are not in conflict with user's list to avoid
Dim ws As Worksheet, blnConflict As Boolean, i As Long
For Each ws In wb.Worksheets
'determine if sheet is visible
If ws.Visible = xlSheetVisible Then
'loop through user's list to avoid
For i = LBound(NamesToAvoid) To UBound(NamesToAvoid)
'if on the avoidance list, set bln and exit loop
If UCase(ws.Name) = Trim(UCase(NamesToAvoid(i))) Then
blnConflict = True
Exit For
End If
Next i
'process appropriate safe sheets
fname = baseWB & "_" & ws.Name & ".pdf"
If Not blnConflict Then ExportPDF ws, fname Else blnConflict = False
End If
Next ws
End Sub
Function ExportPDF(sht As Worksheet, fname As String)
'Purpose: facilitate exporting to pdf
'execute the exporting with some basic parameters set to user's needs
sht.ExportAsFixedFormat Type:=xlTypePDF, Filename:=fname, quality:=xlQualityStandard, _
includedocproperties:=True, ignoreprintareas:=True, openafterpublish:=False
End Function
good luck!