Open Sub Directories and Consolidate Files

The following article will interogate all of the subdirectories in a designated folder using Excel VBA.  The list files in sub directories procedure introduced us to the concept of listing the files in the parent folder and its child folders.  Lets take the concept to a more practical place.  I can do the same with sub directories as I can with a regular open files command?  I can use the procedure from the post above to perform actions on a folder and all its sub folders.  Perhaps you want to consolidate 2013 monthly files into a single master file. If all of the template files are contained within folders with the month names, then the below procedure can be adapted to open these files and incorporate the data.  The following is an example;

Option Explicit

Sub SubDirList() 'Open files using VBA in sub directores and perform an action
Dim sname As Variant
Dim sfil(1 To 1) As String


For Each sname In sfil()
SelectFiles sname
Next sname

End Sub

Private Sub SelectFiles(sPath) 'Excel VBA to Iterate through all the SubDirectories.
Dim Folder As Object
Dim file As Object
Dim fldr
Dim oFSO As Object
Dim i As Integer
Dim owb As Workbook
Dim sh As Worksheet


Set sh=Sheet2
Set oFSO=Createobject("Scripting.FileSystemObject")
Set Folder=oFSO.GetFolder(sPath)

For Each fldr In Folder.SubFolders
SelectFiles fldr.Path
Next fldr

For Each file In Folder.Files
Set owb=Workbooks.Open(file) 'Open all workbooks copy the current Region
[a1].CurrentRegion.Offset(1).Copy sh.Range("A65536").End(xlUp)(2)
owb.Close False
i=i + 1
Next file

Set oFSO=Nothing
End Sub

The above two procedures are run in conjunction with one another. The files should open and the data from each opened file is brought back into the original file. So the VBA will consolidate all of the data.

The following Excel VBA will do the same thing as the above just a lot more succinctly. I learnt this with the assistance of SNB who regularly posts on Ozgrid.

Option Explicit

Sub OpenSubFolders() 'Excel VBA to Iterate through all the SubDirectories without opening
Dim ws As Worksheet
Dim i As Integer
Dim ar As Variant
Dim owb As Workbook
Dim sh As Worksheet
Set ws=Sheet1

ar=Filter(Split(Createobject("").exec("cmd /c Dir ""C:\Users\*.xls"" /b/s").stdout.readall, vbCrLf), ":")

For i=0 To UBound(ar)
With GetObject(ar(i))
With .Sheets(1).UsedRange
ws.Cells(Rows.Count, 1).End(xlUp)(2).Resize(.Rows.Count, .Columns.Count)=.Value
End With .Close False
End With
Next i
End Sub

The code works a little differently as the files do not open on screen.