Looping through all files in all subfolders within selected directory

S

singlespeedmtb

New Member
Joined
Mar 28, 2016
Messages
3
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
 

Excel Facts

How can you automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.
Sort by date Sort by votes
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.

Code: 
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

Code: 
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.
 
Upvote 0
Sorry, got sloppy...

Please make the following substitutions:

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

Code: 
SubfolderLoop SubFolder.Path & "\", True
 
Upvote 0
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?
 
Upvote 0
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?
Click to expand...

Yes.
 
Upvote 0
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?


Code: 
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
 
Upvote 0
Code: 
[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]
 
Upvote 0
And, if you're looking to speed up your macro a bit, use a With construct as follows...

Code: 
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...

Code: 
Application.ScreenUpdating = False
Then at the end, add the line...

Code: 
Application.ScreenUpdating = True
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Solved
Excel VBA to add file name to column C in worksheet
Replies
1
Views
320
mumps
mumps
Kristylee0228
  • Question
Populating Cell based on File Name and using a List
Replies
0
Views
183
Kristylee0228
Kristylee0228
R
  • Question
Loop Through Folder but it NEVER STOPS
Replies
9
Views
682
rollis13
rollis13
J
  • Question
VBA to List all Folders, Subfolders and files in a directory
Replies
4
Views
754
Formula11
F
H
  • Question
Macro to move csv files within-subfolder to folder "Old Templates"
Replies
2
Views
373
howard
H

Forum statistics

Threads
1,214,870
Messages
6,122,019
Members
449,060
Latest member
LinusJE

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top