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
Sub DoStuffInFoldersInFolderRecursion() 'Main Procedure to call the Function LoopThroughEachFolder(objFolder)
Rem 1A) Some Worksheets and General Variables Info
Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets.Item(1) 'Worksheets("RudyMSRQueue") 'CHANGE TO SUIT YOUR WORKSHEET
Dim strDefPath As String: Let strDefPath = ThisWorkbook.Path ' Any Path to Folder to test this code! here we simply use the Path where the File with this code in is
Dim strDefFldr As String: Let strDefFldr = "EileensFldr" 'Just for an initial suggestion
Rem 2A) Get Folder Info ( Using Library Shell32 ( C:\WINDOWS\system32\SHELL32.dll ) Microsoft Shell Controls And Automation )
Dim ShellApp As Shell32.Shell ' The next two lines are the equivalent "Early Binding pair"
Set ShellApp = New Shell32.Shell ''You will need to do select form VB Editor options .. Extras...then scroll down to Microsoft Shell Controls And Automation ... and add a check
Dim objWB As Object, strWB As String 'The .BrowseForFolder Method appears either return a string of the Folder name you choose, or an object which is that chosen Folder, depending on how you declare the variable to put the retuned "thing" in
Set objWB = ShellApp.BrowseForFolder(0, "Please choose a folder", 0, "" & strDefPath & "\" & strDefFldr & "") 'An Object of Folder type returned
Let strWB = CStr(objWB) ' ! Cstr seems not to be necerssary
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 Folder 'An Object from myFolder, can be an declared as Object also
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 Folder, 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 Folder ''This is used continuously as the "steering" thing, that is to say each Sub Folder in Folder loops, in loops, in loops......etc
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 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
'
'
'' http://www.excelforum.com/excel-programming-vba-macros/1126751-get-value-function-loop-through-all-files-in-folder-and-its-subfolders.html
Reply With Quote
Bookmarks