VBA Loop Through a File Path and Run a Code

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:

1. As suggested by SmileyFtW it asks you for the root folder
2. Scans the subfolders for excel files (adjust the extension in code)
3. 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!