Loop through all files in a Directory If exists?

[kvarner]

I have a directory, let's say it's L:\Budget Report\Working File\ and in this directory there are many folders, one for each department (OR7, OR8, ISD, etc.). In each of those department folders there is an excel file called Budget Tool.xlsx And just to point out, there are a couple of odd ball folders in this directory that do not contain that file. I need to make the same changes to the file with the same name in each folder that it exists in.
I have my code written and working perfectly for the changes I need made, but currently I have to change the name of the last folder in the file path of my code and hit run for every one of them individually. There are about 90 of them so that's a little time intensive!

So, what I'm wondering is if there is a way to Loop through all the folders in that directory, and IF the file exists then run the code, if not move to the next folder. It seems like that should be possible.
And in case this will matter, part of the code I run is to copy the Budget Tool.xlsx and rename as Budget Tool Quarter2.xlsx, then the remainder of the code runs on the original basically deleting information and changing dates and things so that it's usable for Quarter3. So the code would need to know to save the new version in the same folder that it's currently in.

Hopefully that makes sense! Any help is appreciated.

 

[bfreescott]

You need a recursive search. This link should get you started.

https://support.microsoft.com/en-us/kb/185601

 

[Norie]

You can use the File System Object to get the subfolders of a folder.

Dim FSO As Object
Dim fld As Object
Dim subfld As Object
Dim fil As Object
Dim strPath As String

    strPath = "L:\Budget Report\Working File\"

    Set FSO = CreateObject("Scripting.FileSystemObject")

    Set fld = FSO.GetFolder(strPath)
    
    For Each subfld In fld.SubFolders
        If FSO.FileExists(subfld.Path & "\Budget Tool.xlsx") Then
            ' do stuff with file
        End If
    Next subfld

 

[kvarner]

Norie, that code seems to be working, when I hover over it I can see the correct folder name in there. But I can't seem to figure out how to reference it in the rest of my code.
It used to contain the full file path and name, but here is what I have now and get a Path/File access error. Any ideas?


For Each subfld In fld.SubFolders
If FSO.FileExists(subfld.Path & "\P33 Budget Tool.xlsx") Then

''To get the BPC Upload Sheet from the Control File Folder...Do Not Change
Set wb = Application.Workbooks.Open("L:\Budget Tool\P33\Working File\Control File\BPC Upload File.xlsx")

''Name of Old Budget Tool File that you are copying, Change folder name for each Division (3 Places)
Set ActiveWB = Application.Workbooks.Open(subfld & "\P33 Budget Tool.xlsx")
Name (subfld & "\P33 Budget Tool.xlsx") As (subfld & "\P33 Budget Tool Before Updates.xlsx")

''Name of New Budget Tool File that you are saving, Change folder name for each Division (Once)
ActiveWB.SaveCopyAs (subfld & "\P33 Budget Tool.xlsx")
ActiveWB.Close False

''To Reference the New Budget Tool you created, Change folder name for each Division
Set NewWB = Application.Workbooks.Open(subfld & "\P33 Budget Tool.xlsx")

 

[Norie]

You are trying to various files/paths etc in that code, where are you getting the error?

 

[kvarner]

It's on the Name....line. But now I need to do a slight update so I'm trying this and it doesn't give me any errors, says it's running but only for about 30 seconds and does nothing. Maybe if we can solve this one I can figure out the bigger one.

Dim FSO As Object
Dim fld As Object
Dim subfld As Object
Dim fil As Object
Dim strPath As String
strPath = "L:\Budget Tool\P33\Working File\"
Set FSO = CreateObject("Scripting.FileSystemObject")
Set fld = FSO.GetFolder(strPath)
For Each subfld In fld.SubFolders
If FSO.FileExists(subfld.Path & "\Budget Tool.xlsx") Then
Application.Workbooks.Open (subfld & "\P33 Budget Tool.xlsx")
Worksheets("Other Accounts").Unprotect Password:="budgetp33"
Worksheets("Other Accounts").AutoFilterMode = False
Worksheets("Other Accounts").Range("M2:R500").Interior.Color = RGB(192, 192, 192)
Worksheets("Other Accounts").Range("M2:R500").Locked = True
Worksheets("Other Accounts").Protect Password:="budgetp33", DrawingObjects:=True, Scenarios:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowFormattingCells:=True, AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True
ActiveWorkbook.Close True
End If
Next subfld