How to loop through two different paths in VBA? [duplicate] - excel

Question

I have the code below that I would like to run to all of the available excel files in a folder. Ideally, I would like to input the path of the folder into cell C3 in Sheet1 and the macro to apply the code to all of the existing files.
The code will simply save the second sheet of each file into a PDF version, it works perfectly standalone.
Sample Folder Path:
C:\Users\MMMM\Desktop\Project X\ Project II
Suggestions on how to approach this?
Private Sub CommandButton1_Click()
Dim MyFolder As String, MyFile As String
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
.Show
MyFolder = .SelectedItems(1)
Err.Clear
End With
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
MyFile = Dir(MyFolder & "\", vbReadOnly)
Do While MyFile <> ""
DoEvents
On Error GoTo 0
Workbooks.Open Filename:=MyFolder & "\" & MyFile, UpdateLinks:=False
Dim ReportSheet As Worksheet
Dim allColumns As Range
Set allColumns = Sheets("RT").Columns("N:S")
allColumns.Hidden = True
With Worksheets("RT").PageSetup
.Zoom = False
.FitToPagesWide = 1
End With
Filename = ActiveWorkbook.Name
Cell = Replace(Filename, ".xlsx", ".PDF")
Set ReportSheet = Sheets("RT")
Sheets("RT").Select
Sheets("RT").PageSetup.Orientation = xlLandscape
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
ThisWorkbook.Path & "\" & Cell, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=True, OpenAfterPublish:=True
0
Workbooks(MyFile).Close SaveChanges:=False
MyFile = Dir
Loop
'turns settings back on that you turned off before looping folders
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
Application.Calculation = xlCalculationManual
End Sub

Answer 1

This needs a reference (see this link)
It's untested (so let me know if anything comes up)
Basically:
As suggested by SmileyFtW it asks you for the root folder
Scans the subfolders for excel files (adjust the extension in code)
Process the DoSomething procedure where you export the file
EDIT: Added handle user cancel file select dialog
Code:
Option Explicit
' Add a reference to Microsoft Scripting Runtime
' See https://vbaf1.com/filesystemobject/create-microsoft-scripting-runtime-library-reference/
Private Sub ProcessAllFilesInFolder()
Dim FileSystem As Scripting.FileSystemObject
Dim fileDialogResult As Office.FileDialog
Dim folderPath As String
Set FileSystem = New Scripting.FileSystemObject
Set fileDialogResult = Application.FileDialog(msoFileDialogFolderPicker)
With fileDialogResult
.AllowMultiSelect = False
.Title = "Select a folder"
If .Show = True Then
folderPath = .SelectedItems(1)
End If
If .SelectedItems.Count = 0 Then Exit Sub
End With
ProcessFolder FileSystem.GetFolder(folderPath)
End Sub
Private Sub ProcessFolder(ByVal targetFolder As Scripting.Folder)
Dim FileSystem As Scripting.FileSystemObject
Dim File As Scripting.File
Dim SubFolder As Scripting.Folder
Set FileSystem = New Scripting.FileSystemObject
For Each SubFolder In targetFolder.SubFolders
ProcessFolder SubFolder
Next
For Each File In targetFolder.Files
If FileSystem.GetExtensionName(File.Name) Like "xls?" And File.Name <> ThisWorkbook.Name Then
DoSomething File.Path
End If
Next
End Sub
Private Sub DoSomething(ByVal filePath As String)
Dim FileSystem As Scripting.FileSystemObject
Dim ReportSheet As Worksheet
Dim targetFileName As String
targetFileName = Replace(ThisWorkbook.Name, ".xlsm", ".PDF")
Set ReportSheet = ThisWorkbook.Worksheets("Sheet2")
ReportSheet.PageSetup.Orientation = xlLandscape
ReportSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
ThisWorkbook.Path & "\" & targetFileName, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=True, OpenAfterPublish:=True
End Sub
Let me know if it works!