Loop subfolders

[dturgel]

Hi,

I got the following code from SpreadsheetGuru and it is a basic loop for all files within a folder (seems he encourages us to ask questions off it - if I'm wrong for whatever reason please excuse the post). Any idea how to modify it to go a level down in folders? Specifically, I have the same pricing file in a pricing folder in each of about 100 accounts that are all in a big folder label 2016, so the link is something like:

G:\2016\[Account Folder]\Pricing\[TargetFile.xl*]

Any idea how to set the loop up this way to modify that pricing file in the pricing folder each time? (It is the only file in the Pricing folders):


Sub LoopAllExcelFilesInFolderMCT()


'PURPOSE: To loop through all Excel files in a user specified folder and perform a set task on them
'SOURCE: Squarespace - Claim This Domain


Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog


'Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual


'Retrieve Target Folder Path From User
Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)


With FldrPicker
.Title = "Select A Target Folder"
.AllowMultiSelect = False
If .Show <> -1 Then GoTo NextCode
myPath = .SelectedItems(1) & "\"
End With


'In Case of Cancel
NextCode:
myPath = myPath
If myPath = "" Then GoTo ResetSettings


'Target File Extension (must include wildcard "*")(DBT added * at end)
myExtension = "*.xl*"


'Target Path with Ending Extention
myFile = Dir(myPath & myExtension)


'Loop through each Excel file in folder
Do While myFile <> ""
'Set variable equal to opened workbook
Set wb = Workbooks.Open(Filename:=myPath & myFile)

'Change First Worksheet's Background Fill Blue
wb.Worksheets(1).Range("Q63") = 330000000

'Save and Close Workbook
wb.Close SaveChanges:=True


'Get next file name
myFile = Dir
Loop


'Message Box when tasks are completed
MsgBox "Task Complete!"


ResetSettings:
'Reset Macro Optimization Settings
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True


End Sub

 

[AlphaFrog]

This uses a different method...

Sub Accounts_Pricing()
    Dim FSO As Object, fsoFile As Object, fsoSubfolder As Object
    Dim strPath As String
    
    MsgBox "Please choose the Main Accounts folder."
    Application.DisplayAlerts = False
    ChDrive "G"
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = "G:\"
        .AllowMultiSelect = False
        If .Show <> -1 Then Exit Sub
        strPath = .SelectedItems(1) & "\"
    End With
    
    Application.ScreenUpdating = False
    Set FSO = CreateObject("Scripting.FileSystemObject")
    'Loop through each subfolder in main path
    For Each fsoSubfolder In FSO.GetFolder(strPath).Subfolders
        'Test if "Pricing" subfolder exists
        If FSO.FolderExists(fsoSubfolder.Path & "\Pricing\") Then
            'Loop through each Excel file in subfolder\Pricing\
            For Each fsoFile In FSO.GetFolder(fsoSubfolder.Path & "\Pricing\").Files
                
                'Open workbook
                With Workbooks.Open(FileName:=fsoFile.Path)
                    'Change First Worksheet's Background Fill Blue
                    .Worksheets(1).Range("Q63") = 330000000
                    'Save and Close Workbook
                    .Close SaveChanges:=True
                End With
                    
            Next fsoFile
        End If
    Next fsoSubfolder
    Application.ScreenUpdating = True
    Set FSO = Nothing
    
End Sub

Please take note of the message below about the use of CODE tags when posting code..

 

[dturgel]

AlphaFrog,

Absolutely fantastic - thanks so much! And duly noted on surrounding the code with code tags - I will do so in the future.

Daniel

 

[AlphaFrog]

You're welcome. Thanks for the feedback.

 

[dturgel]

AlphaFrog,

I created a few loops based on your code - it's so good, thanks so much.

I hit a snag each time when the loop came upon what it saw as a corrupt file. I can't find that file and will ask our network admin to locate it but has this ever happened to you? Any suggestions? It led me to wonder should I use an on error resume next line in there? Also, is this the only way to resume macros or could I have moved forward and skipped that another way? (I tried to Step Over but it would not work). Finally, does the order of the folders in the master folder matter? I'm thinking I could reverse the order by name and then just come down reverse alphabetically until I hit that corrupt file again and then I would have all but that one corrupt one done - what do you think?

Daniel

 

[AlphaFrog]

AlphaFrog,

I created a few loops based on your code - it's so good, thanks so much.

I hit a snag each time when the loop came upon what it saw as a corrupt file. I can't find that file and will ask our network admin to locate it but has this ever happened to you? Any suggestions? It led me to wonder should I use an on error resume next line in there? Also, is this the only way to resume macros or could I have moved forward and skipped that another way? (I tried to Step Over but it would not work). Finally, does the order of the folders in the master folder matter? I'm thinking I could reverse the order by name and then just come down reverse alphabetically until I hit that corrupt file again and then I would have all but that one corrupt one done - what do you think?

Daniel

You may just want to qualify the file names with something like this...

            [COLOR=green]'Loop through each Excel file in subfolder\Pricing\[/COLOR]
            [COLOR=darkblue]For[/COLOR] [COLOR=darkblue]Each[/COLOR] fsoFile [COLOR=darkblue]In[/COLOR] FSO.GetFolder(fsoSubfolder.Path & "\Pricing\").Files
                [COLOR="#FF0000"]If fsoFile.Name Like "*.xls*" Then[/COLOR]
                    [COLOR=green]'Open workbook[/COLOR]
                    [COLOR=darkblue]With[/COLOR] Workbooks.Open(Filename:=fsoFile.Path)
                        [COLOR=green]'Change First Worksheet's Background Fill Blue[/COLOR]
                        .Worksheets(1).Range("Q63") = 330000000
                        [COLOR=green]'Save and Close Workbook[/COLOR]
                        .Close SaveChanges:=[COLOR=darkblue]True[/COLOR]
                    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
                [COLOR="#FF0000"]End If[/COLOR]
            [COLOR=darkblue]Next[/COLOR] fsoFile

If the file name has a base name pattern e.g.; it always starts with say "Test", then you could use an extended pattern match like "Test*.xls*"

 

[dturgel]

Ok great, thanks again!

 

[dturgel]

Alpha Frog,

One more question for you on this. If instead of simply changing one cell's value I want to loop through a big run macro that I have set up, would I just code to Call that Run? In other words instead of this:

'Open workbook
With Workbooks.Open(FileName:=fsoFile.Path)
'Change First Worksheet's Background Fill Blue
.Worksheets(1).Range("Q63") = 330000000
'Save and Close Workbook
.Close SaveChanges:=True
End With

Would I just do something like this:

'Open workbook
With Workbooks.Open(FileName:=fsoFile.Path)
Call Sub Run()
'Save and Close Workbook
.Close SaveChanges:=True
End With
Or is there a different/better way to do this?

Daniel

 

[Terry Echols]

Hi All:

Just so I don't clutter up the board, I have a question posted that is similar to this at https://www.mrexcel.com/forum/excel-questions/94666-password-protect-multiple-files.html

Basically I need to loop through multiple folders and "Protect Sheet" to a file in each sub-folder. I don't want them password protected only locked from editing.

I did fail to mention in the other post, it would not let me edit it after 10 minutes, the following:

In addition to what is posted on the other thread I should say that each of these files have two sheets, one is named "CALLS" the other is hidden & password protected and is named "DD-INFO". This sheet controls the content available in CALLS drop-downs.

I would like to protect the CALLS sheet from editing (but not adding a password) but leaving DD-INFO alone.

I have searched and searched and can't seem to find code that will do what I need and that my limited VBA coding experience can edit.

Any help would be greatly appreciated.

Terry

 

[AlphaFrog]

1. You will likely get more views for your query if you start a new thread of your own. Don't worry about clutter. Asking questions is sort of the point of the forum.
2. You have different information in two threads now. It puts the burden on the readers to sus out what you want from both threads.
3. It's not clear what you mean by; "I don't want them password protected only locked from editing." That's one of the purposes of password protecting a sheet. So why no password protection? The only other way I can think of is to tag each file as write protected. That means the file can be edited, but not saved over the original. The user could save it as a different file name though.

So start a new thread with the above points in mind. Include links to these two older threads if you like.