Looping through subfolders

[ECSTFSS]

Hello

I have a programme that updates a master workbook (performq2y.xlsx) with data from worksheets contained in 24 workbooks in a specific source folder ("c:\data\persist2y\persistance_2y120"). The problem now is that I have 120 folders (again each with 24 workbooks) in the source folder (last three digits of source folder run from1 to 120). I want to update the master workbook with data from 2,880 (24 x 120) worksheets from all the worksheets contained in the 120 folders. I could run my existing VBA programme 120 times, but that seems very silly. Is there a way to adapt my VBA programme to do this all in one step? I attach my existing programme.

Please Login or Register  to view this content.

[ragulduy]

I would normally do some sort of recursive loop using filescripting for something like this, for example

Please Login or Register  to view this content.

[ECSTFSS]

Thanks I will try that now.

[ECSTFSS]

Following the suggestion yudlugar, I adopted my VBA programme to loop through 120 subfolders within the main folder. In case anyone else comes across this problem, I attach my code below.

Private Sub CommandButton1_Click()


Dim wb1 As Workbook
Dim wb2 As Workbook
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim rng1 As Range
Dim rng2 As Range
Dim rng3 As Range
Dim rng4 As Range
Dim rng5 As Range
Dim rng6 As Range
Dim rng7 As Range
Dim rng8 As Range
Dim rng9 As Range
Dim rng10 As Range
Dim rng11 As Range
Dim rng12 As Range
Dim rng13 As Range
Dim rng14 As Range
Dim Master As Workbook
Dim sourceBook As Workbook
Dim sourceData As Worksheet
Dim CurrentFileName As String
Dim Directory As String
Dim myPath As String
Dim lrow As Long


Application.ScreenUpdating = False
Application.DisplayAlerts = False

Set Master = wb1

Set wb1 = Workbooks.Open(Filename:="c:\data\persistresults\performq2y.xlsx")
Set ws1 = wb1.Worksheets("BystrategySRd")
Dim strFile As String
Dim objFSO, destRow As Long
Dim mainFolder, mySubFolder
Set objFSO = CreateObject("Scripting.FileSystemObject")
mFolder = "C:\data\persist2y\"
Set mainFolder = objFSO.GetFolder(mFolder)
For Each mySubFolder In mainFolder.subfolders
strFile = Dir(mySubFolder & "\*.xls")
Do
Workbooks.Open mySubFolder & "\" & strFile
Set sourceBook = Workbooks(strFile)
Set sourceData = sourceBook.Worksheets(9)



Set rng1 = ws1.Range("b65536").End(xlUp).Offset(1, 0)
Set rng2 = ws1.Range("c65536").End(xlUp).Offset(1, 0)
Set rng3 = ws1.Range("d65536").End(xlUp).Offset(1, 0)
Set rng4 = ws1.Range("e65536").End(xlUp).Offset(1, 0)
Set rng5 = ws1.Range("f65536").End(xlUp).Offset(1, 0)
Set rng6 = ws1.Range("g65536").End(xlUp).Offset(1, 0)
Set rng7 = ws1.Range("h65536").End(xlUp).Offset(1, 0)
Set rng8 = ws1.Range("i65536").End(xlUp).Offset(1, 0)
Set rng9 = ws1.Range("j65536").End(xlUp).Offset(1, 0)
Set rng10 = ws1.Range("k65536").End(xlUp).Offset(1, 0)
Set rng11 = ws1.Range("l65536").End(xlUp).Offset(1, 0)
Set rng12 = ws1.Range("m65536").End(xlUp).Offset(1, 0)
Set rng13 = ws1.Range("n65536").End(xlUp).Offset(1, 0)
Set rng14 = ws1.Range("o65536").End(xlUp).Offset(1, 0)




With sourceData

rng1 = sourceData.Range("f4")
rng2 = sourceData.Range("f5")
rng3 = sourceData.Range("f6")
rng4 = sourceData.Range("f7")
rng5 = sourceData.Range("f8")
rng6 = sourceData.Range("f9")
rng7 = sourceData.Range("f10")
rng8 = sourceData.Range("f11")
rng9 = sourceData.Range("f12")
rng10 = sourceData.Range("f13")
rng11 = sourceData.Range("f14")
rng12 = sourceData.Range("f15")
rng13 = sourceData.Range("f16")
rng14 = sourceData.Range("f17")

End With

sourceBook.Close

'Calling DIR w/o argument finds the next .xlsx file within the current directory.
strFile = Dir()

Loop While strFile <> ""
Next

MsgBox "Done Did It!"

Application.ScreenUpdating = True
Application.DisplayAlerts = True


End Sub