CODEWITHSUNDEEP
excelvbaloopssubdirectory
edc94
edc94

Reputation: 1

Loop through subfolders and files using dynamic filename

The code below loops through my subfolders and files to open up a file with a specific filename (either in the form "Daily Report dd-mm-yyyy DAY-END.xlsx" or "Weekly Report dd-mm-yyyy DAY-END.xlsx"), copy and paste the relevant data, and then close the workbook.

The filename is dynamic and based on my MASTER excel.

I am struggling to see the logic behind the order in which fso runs through the subfolders and files. Some files are missed based on their name (they don't have the same naming convention so aren't in date order) and I have to manually run the code again to look for the lastrow.

How do I Exit the subfolder loop IF the relevant file is found, redefine the lastrow and filename, and then start the subfolder/CurrFile loop again based on the new filename? Ideally I want this to run until the filename contains today's date.

Sub LoopSubfoldersAndFiles()

Dim fso As Object 
Dim folder As Object
Dim subfolders As Object
Dim filename As String
Dim wb As Workbook
Dim CurrFile As Object
Dim lastrow As Long
Dim MASTERwb As Workbook
Dim MASTERws As Worksheet
Dim MASTER As String
MASTER = "MASTER Report.xlsm"

With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
End With

Set MASTERwb = Workbooks(MASTER) 'define this workbook
Set MASTERws = MASTERwb.Sheets("Sheet1") 'define this worksheet
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(“\\....\”)
Set subfolders = folder.subfolders

'find the last filled row in column D
lastrow = MASTERws.Cells(Rows.Count, "D").End(xlUp).Row

'set filename as the cell reference in column A of the first empty row
' (column A contains the exact filename corresponding to a certain date)
filename = MASTERws.Cells(lastrow + 1, 1).Value

For Each subfolders In subfolders

    Set CurrFile = subfolders.Files

    For Each CurrFile In CurrFile
        If CurrFile.Name = filename Then
            Set wb = Workbooks.Open(subfolders.Path & "\" & filename) 
            [code to copy and paste relevant data from file to MASTER]
            wb.Close SaveChanges:=False 'close workbook
        End If

        lastrow = MASTERws.Cells(Rows.Count, "D").End(xlUp).Row 'redefine lastrow 
        filename = MASTERws.Cells(lastrow + 1, 1).Value 'redefine filename 

    Next

Next

Set fso = Nothing
Set folder = Nothing
Set subfolders = Nothing

With Application
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
End With

End Sub

Upvotes: 0

Views: 304

Answers (1)

HTH
HTH

Reputation: 2031

you could need to change the two loops as follows:

For Each folder In subfolders

    For Each CurrFile In subfolders.Files
        If CurrFile.Name = filename Then
            Set wb = Workbooks.Open(subfolders.Path & "\" & filename)
            [code to copy and paste relevant data from file to MASTER]
            wb.Close SaveChanges:=False 'close workbook

            lastrow = MASTERws.Cells(Rows.Count, "D").End(xlUp).Row 'redefine lastrow
            filename = MASTERws.Cells(lastrow + 1, 1).Value 'redefine filename
            Exit For
        End If
    Next

Next

but your wording is somehow vague and you may want to enhance it if what above doesn't solve your question

Upvotes: 1

Related Questions