Convert spreadsheets from folder to PDF (Save to different location) - excel

Question

I want to select where to save the PDFs instead of saving them to the folder where the excel files live.
I also want to only print the first worksheet.
The Dims ending with a 2 is what I added to try and make this work. I get both pop ups to appear but after I select where I want to save the PDFs then it fails at Set objFolder2 = objFileSystem2.GetFolder(strPath2)
Any help is much appreciated.
Sub ExcelPlot()
Dim objShell As Object
Dim objWindowsFolder As Object
Dim objWindowsFolder2 As Object
Dim strWindowsFolder As String
'Select the specific Windows folder
Set objShell = CreateObject("Shell.Application")
Set objWindowsFolder = objShell.BrowseForFolder(0, "Locate the Excel files", 0, "")
'Select where to save to
Set objShell = CreateObject("Shell.Application")
Set objWindowsFolder2 = objShell.BrowseForFolder(0, "Where would you like to save the PDFs?", 0, "")
If Not objWindowsFolder Is Nothing Then
strWindowsFolder = objWindowsFolder.self.Path & "\"
Call ProcessFolders(strWindowsFolder)
'Open the windows folder
Shell "Explorer.exe" & " " & strWindowsFolder, vbNormalFocus
End If
End Sub
Sub ProcessFolders(strPath As String)
Dim strPath2 As String
Dim objFileSystem As Object
Dim objFileSystem2 As Object
Dim objFolder As Object
Dim objFolder2 As Object
Dim objFile As Object
Dim objExcelFile As Object
Dim objWorkbook As Excel.Workbook
Dim strWorkbookName As String
Set objFileSystem = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFileSystem.GetFolder(strPath)
Set objFolder2 = objFileSystem2.GetFolder(strPath2)
For Each objFile In objFolder.Files
strFileExtension = objFileSystem.GetExtensionName(objFile)
If LCase(strFileExtension) = "xls" Or LCase(strFileExtension) = "xlsx" Then
Set objExcelFile = objFile
Set objWorkbook = Application.Workbooks.Open(objExcelFile.Path)
strWorkbookName = Left(objWorkbook.Name, (Len(objWorkbook.Name) - Len(strFileExtension)) - 1)
objWorkbook.ExportAsFixedFormat Type:=xlTypePDF, fileName:=strPath2 & strWorkbookName & ".pdf"
objWorkbook.Close False
End If
Next
'Process all folders and subfolders
If objFolder.SubFolders.Count > 0 Then
For Each objSubFolder In objFolder.SubFolders
If ((objSubFolder.Attributes And 2) = 0) And ((objSubFolder.Attributes And 4) = 0) Then
ProcessFolders (objSubFolder.Path)
End If
Next
End If
End Sub
Thanks

Answer 1

You can do something like this - you need to pass both of the paths to ProcessFolders
Sub ExcelPlot()
Dim sourceFolder As String, destFolder As String
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
.Title = "Locate the Excel files"
If .Show = -1 Then
sourceFolder = .SelectedItems(1)
.Title = "Where would you like to save the PDFs?"
If .Show = -1 Then
destFolder = .SelectedItems(1)
ProcessFolders sourceFolder, destFolder
Shell "Explorer.exe" & " " & destFolder, vbNormalFocus
End If
End If
End With
End Sub
EDIT: Here's an updated (non-recursive) version of your folder processing sub:
Sub ProcessFolders(sourceFolder As String, destFolder As String)
Dim objFileSystem As Object
Dim objFolder As Object
Dim objSubFolder As Object
Dim objFile As Object
Dim objWorkbook As Excel.Workbook
Dim strWorkbookName As String, strFileExtension As String
Set objFileSystem = CreateObject("Scripting.FileSystemObject")
Dim colFolders As New Collection
colFolders.Add sourceFolder
Do While colFolders.Count > 0
Set objFolder = objFileSystem.GetFolder(colFolders(1)) 'get the first path
colFolders.Remove 1 'remove from listing
'Process files in this folder
For Each objFile In objFolder.Files
strFileExtension = objFileSystem.GetExtensionName(objFile)
If LCase(strFileExtension) = "xls" Or LCase(strFileExtension) = "xlsx" Then
Set objWorkbook = Application.Workbooks.Open(objFile.Path)
strWorkbookName = Left(objWorkbook.Name, _
(Len(objWorkbook.Name) - Len(strFileExtension)) - 1)
objWorkbook.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=objFileSystem.buildpath(destFolder, strWorkbookName & ".pdf")
objWorkbook.Close False
End If
Next
'Process subfolders
For Each objSubFolder In objFolder.SubFolders
If ((objSubFolder.Attributes And 2) = 0) And ((objSubFolder.Attributes And 4) = 0) Then
colFolders.Add objSubFolder.Path 'add this to the collection for processing
End If
Next
Loop
End Sub