Looping through all files in all subfolders within selected directory

[singlespeedmtb]

I have a set of code written to update some cells in a number of excel files that all share the same general format. I am able to get this code to work on all files within a folder but we literally have a directory of hundreds of subfolders organizing our files. I need to be able to loop through all of the files within these subfolders to fun these updates. Can anyone take a look and see what I am missing here? I've spend the last 3 hours on google trying to find the solution and it looks like I need to be using the fso function, but I have no idea how to incorporate that into my existing code. Here is the code I have:

Sub Update_All_Workbooks_In_Folder()


Dim MyFolder As String


Dim MyFile As String


Dim wbk As Workbook



'On Error Resume Next


Application.ScreenUpdating = False


'Opens the folder picker


With Application.FileDialog(msoFileDialogFolderPicker)


.Title = "Select a folder"


.Show


.AllowMultiSelect = False


If .SelectedItems.Count = 0 Then 'Exit if none selected

MsgBox "You did not select a folder”"


Exit Sub


End If


MyFolder = .SelectedItems(1) & "\" 'Assigns selected folder to MyFolder


End With


MyFile = Dir(MyFolder) 'DIR retrieves the first file in MyFolder


'Loop through all files in a folder


Do While MyFile <> “”


'Opens the file and assigns to the wbk variable for future use


Set wbk = Workbooks.Open(Filename:=MyFolder & MyFile)
Application.AskToUpdateLinks = False


Sheets("Blank Template").Range("E2").Formula = "=vlookup(warehouse,Warehouse!A:B,2,0)"


Sheets("Blank Template").Range("E2").VerticalAlignment = xlTop


Sheets("Blank Template").Range("E3").Value = "=vlookup(warehouse,Warehouse!A:E,5,0)"


Sheets("Blank Template").Range("E4").Value = "=(VLOOKUP(warehouse,Warehouse!A:G,6,0)&VLOOKUP(warehouse,Warehouse!A:H,7,0)&VLOOKUP(warehouse,Warehouse!A:H,8,0))"


Sheets("Blank Template").Range("F5").Value = "=VLOOKUP(warehouse,Warehouse!A:D,4,0)"


wbk.Close savechanges:=True


MyFile = Dir 'DIR gets the next file in the folder


Loop


Application.ScreenUpdating = True


End Sub

 

[tonyyy]

One approach is to use a two-part construct. The first macro prompts you to select the top level folder. It then passes two arguments to the second macro which loops through the folder and its subfolders.

Option Explicit

Dim FolderPath As String
Sub StartSubfolderLoop()

With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Select a folder"
    .Show
    .AllowMultiSelect = False
    If .SelectedItems.Count = 0 Then    'Exit if none selected
        MsgBox "You did not select a folder”"
        Exit Sub
    End If
    FolderPath = .SelectedItems(1) & "\"
End With

SubfolderLoop FolderPath, True 'True includes subfolders; False excludes subfolders
   
End Sub

Sub SubfolderLoop(SourceFolderName As String, IncludeSubfolders As Boolean)

' set a reference to Microsoft Scripting Runtime

Dim fso As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder
Dim SubFolder As Scripting.Folder
Dim FileItem As Scripting.File
Dim wbk As Workbook

Set fso = New Scripting.FileSystemObject
Set SourceFolder = fso.GetFolder(SourceFolderName)
 
For Each FileItem In SourceFolder.Files
    'Opens the file and assigns to the wbk variable for future use
    Set wbk = Workbooks.Open(FolderPath & FileItem.Name)
    Application.AskToUpdateLinks = False
    Sheets("Blank Template").Range("E2").Formula = "=vlookup(warehouse,Warehouse!A:B,2,0)"
    Sheets("Blank Template").Range("E2").VerticalAlignment = xlTop
    Sheets("Blank Template").Range("E3").Value = "=vlookup(warehouse,Warehouse!A:E,5,0)"
    Sheets("Blank Template").Range("E4").Value = "=(VLOOKUP(warehouse,Warehouse!A:G,6,0)&VLOOKUP(warehouse,Warehouse!A:H,7,0)&VLOOKUP(warehouse,Warehouse!A:H,8,0))"
    Sheets("Blank Template").Range("F5").Value = "=VLOOKUP(warehouse,Warehouse!A:D,4,0)"
    wbk.Close savechanges:=True
Next FileItem

If IncludeSubfolders Then
    For Each SubFolder In SourceFolder.SubFolders
        SubfolderLoop SubFolder.Path, True
    Next SubFolder
End If

Set FileItem = Nothing
Set SourceFolder = Nothing
Set fso = Nothing
      
End Sub

Cheers,

tonyyy

p.s. You should try using code tags when posting code; makes it much easier to read.

 

[tonyyy]

Sorry, got sloppy...

Please make the following substitutions:

Set wbk = Workbooks.Open(SourceFolderName & FileItem.Name)

SubfolderLoop SubFolder.Path & "\", True

 

[singlespeedmtb]

Thanks tonyyy! That worked perfectly.

Related to your ps note, how do I add code tags on the site? I've never done that. Is it as simple as selecting the text and then pressing the hashtag icon in the wysiwyg toolbar?

 

[tonyyy]

You're welcome. Glad that worked out.

Is it as simple as selecting the text and then pressing the hashtag icon in the wysiwyg toolbar?

Yes.

 

[singlespeedmtb]

I have one additional challenge that I didn't forsee running into with this cleanup. There are other files located within these directories that are being opened as part of this routine. Because they have a different structure (specifically don't have the worksheet name that I am looking for) it isn't updating any of these, but it is opening them and then throwing an error because the specific sheet name isn't found. I can put it into debug and skip to the next step in the code, but ideally I wouldn't have to babysit this routine and do this. I thought about using the On Error function but if I do Resume Next, it leaves the files open and after a bit hangs up and I have to manually skip anyway. I also thought about On Error GoTo with some code to close the current file, but with that I wasn't sure how to resume back to the primary loop of code being run. Anyone have any ideas?

Option Explicit


Dim FolderPath As String
Sub StartTemplateRefUpdate()


With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Select a folder"
    .Show
    .AllowMultiSelect = False
    If .SelectedItems.Count = 0 Then    'Exit if none selected
        MsgBox "You did not select a folder”"
        Exit Sub
    End If
    FolderPath = .SelectedItems(1) & "\"
End With


TemplateRefUpdate FolderPath, True 'True includes subfolders; False excludes subfolders
   
End Sub


Sub TemplateRefUpdate(SourceFolderName As String, IncludeSubfolders As Boolean)


' set a reference to Microsoft Scripting Runtime


Dim fso As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder
Dim SubFolder As Scripting.Folder
Dim FileItem As Scripting.File
Dim wbk As Workbook
Dim wsCheck As Worksheet


Set fso = New Scripting.FileSystemObject
Set SourceFolder = fso.GetFolder(SourceFolderName)
 
For Each FileItem In SourceFolder.Files
    'Opens the file and assigns to the wbk variable for future use
    Set wbk = Workbooks.Open(SourceFolderName & FileItem.Name)
    Application.AskToUpdateLinks = False
    Application.DisplayAlerts = False
        
        Sheets("Blank Template").Range("E2").Formula = "=vlookup(warehouse,Warehouse!A:B,2,0)"
        Sheets("Blank Template").Range("E2").VerticalAlignment = xlTop
        Sheets("Blank Template").Range("E3").Value = "=vlookup(warehouse,Warehouse!A:E,5,0)"
        Sheets("Blank Template").Range("E4").Value = "=(VLOOKUP(warehouse,Warehouse!A:G,6,0)&VLOOKUP(warehouse,Warehouse!A:H,7,0)&VLOOKUP(warehouse,Warehouse!A:H,8,0))"


        Sheets("Blank Template").Range("F5").Value = "=VLOOKUP(warehouse,Warehouse!A:D,4,0)"
        wbk.Close savechanges:=True
        Application.AskToUpdateLinks = False
        Application.DisplayAlerts = False
        Next FileItem


If IncludeSubfolders Then
    For Each SubFolder In SourceFolder.SubFolders
        TemplateRefUpdate SubFolder.Path & "\", True
    Next SubFolder
End If


Set FileItem = Nothing
Set SourceFolder = Nothing
Set fso = Nothing
      
End Sub

 

[tonyyy]

[COLOR=#0000ff]Dim ws As Worksheet[/COLOR][COLOR=#808080]

For Each FileItem In SourceFolder.Files
    'Opens the file and assigns to the wbk variable for future use
    Set wbk = Workbooks.Open(SourceFolderName & FileItem.Name)
    [/COLOR][COLOR=#0000ff]On Error Resume Next
    Set ws = Sheets("Blank Template")
    On Error GoTo 0
    If Not ws Is Nothing Then[/COLOR][COLOR=#808080]
        Application.AskToUpdateLinks = False
        Application.DisplayAlerts = False

        Sheets("Blank Template").Range("E2").Formula = "=vlookup(warehouse,Warehouse!A:B,2,0)"
        Sheets("Blank Template").Range("E2").VerticalAlignment = xlTop
        Sheets("Blank Template").Range("E3").Value = "=vlookup(warehouse,Warehouse!A:E,5,0)"
        Sheets("Blank Template").Range("E4").Value = "=(VLOOKUP(warehouse,Warehouse!A:G,6,0)&VLOOKUP(warehouse,Warehouse!A:H,7,0)&VLOOKUP(warehouse,Warehouse!A:H,8,0))"
        Sheets("Blank Template").Range("F5").Value = "=VLOOKUP(warehouse,Warehouse!A:D,4,0)"
        wbk.Close savechanges:=True
   [/COLOR][COLOR=#0000ff] Else
        wbk.Close savechanges:=False
    End If[/COLOR][COLOR=#808080]
    Application.AskToUpdateLinks = False
    Application.DisplayAlerts = False
Next FileItem[/COLOR]

 

[tonyyy]

And, if you're looking to speed up your macro a bit, use a With construct as follows...

With Sheets("Blank Template")
    .Range("E2").Formula = "=vlookup(warehouse,Warehouse!A:B,2,0)"
    .Range("E2").VerticalAlignment = xlTop
    .Range("E3").Value = "=vlookup(warehouse,Warehouse!A:E,5,0)"
    .Range("E4").Value = "=(VLOOKUP(warehouse,Warehouse!A:G,6,0)&VLOOKUP(warehouse,Warehouse!A:H,7,0)&VLOOKUP(warehouse,Warehouse!A:H,8,0))"
    .Range("F5").Value = "=VLOOKUP(warehouse,Warehouse!A:D,4,0)"
End With

Also, at the beginning of the SubFolderLoop macro, add the line...

Application.ScreenUpdating = False

Then at the end, add the line...

Application.ScreenUpdating = True