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

Suggest you use a built in dialog to get the folder path. Avoid using ActiveSheet and use specific, fully qualified sheets, including the specific workbook. SO is here to suggest fixes for code that fails or does not do what you expect. Take the coding in small steps. Get your code to do what you want to a specific file (hardwired) and nothing else. Then add code to operate only on a specific file type. Then loop files in a specific folder specified in your code (hardwired), Continue expanding capabilities. — SmileyFtW
– SmileyFtW, Commented Feb 14, 2020 at 20:31

Ricardo Diaz · Accepted Answer · 2020-02-18 16:38:57Z

3

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!

edited Feb 18, 2020 at 16:38

answered Feb 14, 2020 at 20:46

Ricardo Diaz

5,7262 gold badges24 silver badges34 bronze badges

Sign up to request clarification or add additional context in comments.

15 Comments

Ricardo Diaz Over a year ago

Hi! Sure. Have a look at the instructions at the begining of my answer. This needs a reference (see this link)....

Ricardo Diaz Over a year ago

Hi! please see my edit.Added this line: If .SelectedItems.Count = 0 Then Exit Sub

Ricardo Diaz Over a year ago

Aswesome. You can add a Msgbox "your message" at the end. for the counter, add a variable like Dim counter as long and you can increment it by counter = counter + 1

Ricardo Diaz Over a year ago

Put the declaration below Option Explicit (that way is available to all procedures) and then increment it inside DoSomething sub, finally in the msgbox line add ..."your message " & counter

MMMM Over a year ago

Oh nice, I see the logic in there now!! That's smart, thank you. Now I got the times the loop ran and the the time it took the macro to be completed! Figured out all the variables that I didn't declare too!! Thank you Ricardo, I think this project is now completed!

|

Collectives™ on Stack Overflow

VBA Loop Through a File Path and Run a Code

1 Answer 1

15 Comments

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

15 Comments

Your Answer

Sign up or log in

Post as a guest

Linked

Related