My codes ( again in color!! )
Main Code
Sub DoStuffInFoldersInFolderRecursion()
And called Routine
Sub LoopThroughEachFolderAndItsFile(
Code:
Option Explicit
'
'http://excelpoweruser.blogspot.de/2012/04/looping-through-folders-and-files-in.html http://www.excelforum.com/excel-programming-vba-macros/1126751-get-value-function-loop-through-all-files-in-folder-and-its-subfolders.html#post4316662 http://www.excelfox.com/forum/f5/loop-through-files-in-a-folder-using-vba-1324/
Sub DoStuffInFoldersInFolderRecursion() 'Main Procedure to call the Function LoopThroughEachFolderAndItsFile(
Rem 1A) Some Worksheets and General Variables Info
Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets.Item(1) 'Worksheets("EFFldr") 'CHANGE TO SUIT YOUR WORKSHEET
Rem 2A) Get Folder Info ( Using VBA Application.FileDialog(msoFileDialogFolderPicker) Property )
Dim strWB As String
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Folder Select "
.AllowMultiSelect = False
If .Show <> -1 Then
Exit Sub
End If
Let strWB = .SelectedItems(1) & "\"
End With
Rem 3A )
Dim FSO As Object: Set FSO = CreateObject("Scripting.FileSystemObject") 'Late Binding
'Dim FSO As Scripting.FileSystemObject 'Early Binding alternative activate a reference to the Microsoft Scripting Runtime Library ( MSRL ) in the Tools References menu of VB Editor Options.
'Set FSO = New Scripting.FileSystemObject 'Create an Instance of the Class Scripting FileSystemObject
Dim myFolder As Object 'An Object from myFolder, can be an declared as Dim myFolder As Folder also for Early Binding
Set myFolder = FSO.GetFolder(strWB) 'Set the selected Folder to the Object Folder using this Method which takes as arbument the Full String Path
Rem 4A )
Dim rCnt As Long, CopyNumber As Long: Let rCnt = 1: Let CopyNumber = 1 '"Run progressin ( "down vertical" ) axis ( Row count for output ), "Down Folder chain to the right", The Count of the Copy of the called Procedue
Dim celTL As Range: Set celTL = ws.Range("A1") 'Top left of where Licting should go
celTL.Value = myFolder.Path: celTL.Offset(0, 1).Value = myFolder.Name: ws.Columns("A:C").AutoFit 'First output Row
Call LoopThroughEachFolderAndItsFile(myFolder, celTL, rCnt, CopyNumber) 'Up until now we just got the initial Folder. Now we go to all sub folders then all subfolders then all subfolders.......
Application.ScreenUpdating = True
MsgBox "All Excel Files processed", vbInformation
ws.Columns("A:H").AutoFit
End Sub
Rem 5A)
Sub LoopThroughEachFolderAndItsFile(ByVal fldFldr As Object, ByRef celTL As Range, ByRef rCnt As Long, ByVal CopyNumberFroNxtLvl As Long) 'In below function we have a nested loop to iterate each files also
Dim myFldrs As Object ''This is used continuously as the "steering" thing, that is to say each Sub Folder in Folder loops, in loops, in loops......etc ....can be Dim myFldrs As Folder for early bindingDim CopyNumber As Long 'equivalent to clmLvl in Rudis Q code
Dim CopyNumber As Long 'equivalent to clmLvl in Rudis Q code
If CopyNumber = 0 Then CopyNumber = CopyNumberFroNxtLvl 'If this variable in this Copy of the Routine has not been set then we have reached the next Copy for the First time, so set the variable so we have an indication ( number to the right or "down" Folder Chain
'5Ab) Doing stuff for current Folder
For Each myFldrs In fldFldr.SubFolders 'SubFolders collection used to get at all Sub Folders
''''''''Doing stuff for each Folder
Let rCnt = rCnt + 1 + 1 ''At each folder we always move down a line, and a dd amm extra line as a space between Folders ( The indication of the "column" or "down" to the right comes from the Copy Number of the Sub Procedure
celTL.Cells(rCnt, 1).Value = myFldrs.Path: celTL.Cells(rCnt, CopyNumber).Offset(0, 2).Value = myFldrs.Name: 'Print out current Folder Path and Name in next free row.
''''''''End doing stuff for each Folder
'5Ac) Doing stuff for current file.
Dim oFile As Object ' ... for early binding can Dim oFile As file
For Each oFile In myFldrs.Files 'Looking at all Files types initially '#####
''''''''Doing Stuff for Each File
' Dim Extension As String: Let Extension = Right(oFile.Name, (Len(oFile.Name) - (InStrRev(oFile.Name, ".")))) 'To get the bit just after the . dot.
' If Left(Extension, 3) = "xls" Then 'Check for your required File Type #####
Let rCnt = rCnt + 1
celTL.Cells(rCnt, CopyNumber).Offset(0, 2).Value = oFile.Name ' Do your stuff here
' Dim wkb As Workbook
On Error GoTo ErrHdlr 'In case problem opening file for example
' Set wkb = Workbooks.Open(oFile)
' wkb.Close SaveChanges:=True
' Else 'Do not do stuff for a Bad Extension
' End If
''''''''End Doing Sttuff for Each File
NxtoFile: Next oFile ' Spring Point after error handler so as to go on to next File after the File action that errored
Call LoopThroughEachFolderAndItsFile(myFldrs, celTL, rCnt, CopyNumber + 1) 'This is an example of recursion. It is actually very simple once you understand it. But it is just incredibly difficult to put in words. It is basically a Procedure that keeps calling itself as much as necessary as it goes "along", "down", or "to the right" of the Path "roots". Every time it goes off calling itself VBA runs a copy of that Procedure. It "Stacks" all info carefully for each "Copy" Run and continues to do this "drilling" down as far as it must, in this case finding the Next Folder, and then the next Folder in that, then the next Folder in that, then the next Folder in that...I think you get the point! Each time VBA makes a copy of the Routine and you go into that. The calling Routine then "freezes at its current state and all variable keep there values. The "Frozen" Routine then re starts when the copy finishes
Next
Exit Sub 'Normal End for no Errors
Rem 6 ) Error handler section just put here for convenience
ErrHdlr: 'Hopefully we know why we are here, and after informing can continue ( to next file )
MsgBox prompt:="Error " & Err.Description & " with File " & oFile & ""
On Error GoTo -1 'This needs to be done to reset the VBA exceptional error state of being. Otherwise VBA "thinks" Errors are being handeled and will not respond again to the Error handler.
On Error GoTo 0 ' Swiches off the current error handler. I do not really need to do this. But it is good practice so the error handler is only in place at the point where i next am expecting an error
GoTo NxtoFile
End Sub
Reply With Quote
Bookmarks