cycling through all sub-folders in a folder

**dyesol** · 06-09-2011, 10:13 AM

Hi all,

I have a macro (lets call it weatherdata) to perform certain functions on a given folder containing a number of text files that I import to excel and manipulate.

This must be run for each folder contained within a main folder.

To speed things up I would like a macro which identifies all sub-folders within a particular main folder
(lets call its location C:\test macro),
runs my macro for the first given subfolder, then moves on to the next sub-folder and runs the macro again and so on until all the sub-folders in the main folder have been gone through.

The main folder name will stay constant, however the sub-folder names will be variable.
All sub-folders should have the macro performed on them (i.e. I don't need to avoid any sub-folders), however if they could be cycled through by order of name (a-z) this would be benificial (though not essential).

I hadn't expected this to be so difficult, I would use a "With Application.FileSearch" but I am looking to cycle through folders not files!

Usually I'd just search the forums and adapt something, but I've searched for a while now with no success so I'm biting the bullet and posting!
I'd really appreciate any suggestions.

Ben

**abousetta** · 06-09-2011, 10:33 AM

Hi Ben,

FileSearch won't work in all cases because you are using Excel 2007

This is what I use as a generic looping code:

Sub Generic_Loop_Through_Files()

Dim CalcMode                As Long
Dim screenUpdateState       As Variant
Dim statusBarState          As Variant
Dim eventsState             As Variant
Dim fso                     As Object
Dim fpath                   As String

    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Please Select a Folder"
        .ButtonName = "Select Folder"
        .InitialFileName = "C:\Users\HP-Server\Desktop\"
        .AllowMultiSelect = False
        .Show
        If .SelectedItems.Count > 0 Then
            fpath = .SelectedItems(1) & "\"
        Else
            MsgBox "No folder was chosen." & vbLf & vbLf & "Please try again.", vbExclamation, "User Cancelled."
            Exit Sub
        End If
    End With

' Turn off some Excel functionality so your code runs faster
    screenUpdateState = Application.ScreenUpdating
    statusBarState = Application.DisplayStatusBar
    eventsState = Application.EnableEvents

    With Application
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .DisplayStatusBar = False
        .EnableEvents = False
        .DisplayAlerts = False
    End With
    
' Use File System Object to choose folder with files
    Set fso = CreateObject("Scripting.FileSystemObject")
    
'Call the ProcessFolders macro to loop through folders
    Call ProcessFolders(fso, fpath)

' Turn Excel functionality back on
    With Application
        .Calculation = CalcMode
        .ScreenUpdating = screenUpdateState
        .DisplayStatusBar = statusBarState
        .EnableEvents = eventsState
        .Calculation = CalcMode
    End With

MsgBox "Automation completed...", vbInformation

End Sub

Sub ProcessFolders(ByRef fso, ByVal fpath)

Dim myFolder, mySubFolder, myFile
Dim wkb                     As Workbook
Dim SavePath                As String
    
' Open each file consequently
    Set myFolder = fso.GetFolder(fpath)

        For Each myFile In myFolder.Files
            If LCase(myFile.Name) Like "*.xls*" Then
            
                ' Perform tasks with each file
                    Set wkb = Workbooks.Open(myFile)
                    
                ' First worksheet only - change according to needs
                    With wkb.Worksheets(1)
                    
'*******************************************
'* Add code to do something with each file *
'*******************************************

                    End With
                        
'                'Save file in original folder, but as a different file format (Option 1)
'                   wkb.SaveAs Left(myFile, InStr(1, myFile, ".xls") - 1), xlCSV
                
'                ' Save file in original folder, but as different file format (Option 2)
'                    SavePath = fso.GetFolder(fpath).Name & "\" & fso.GetBaseName(myFile) & ".xls"
'                    wkb.SaveAs fileName:=SavePath, FileFormat:=xlNormal, CreateBackup:=False
                    
                ' Close file (saving = True)
                    wkb.Close savechanges:=True
            End If
' Loop through all files in folder
        Next myFile
            
' Loop through all subfolders
    For Each mySubFolder In myFolder.SubFolders
        Call ProcessFolders(fso, mySubFolder)
    Next mySubFolder

End Sub

Good luck.

abousetta

**dyesol** · 06-09-2011, 11:38 AM

Thanks abousetta,

my initial thoughts are my god that looks complicated!!, but I'll have a go at ploughing my way through it and seeing if I can't adapt it for my purpose.

**abousetta** · 06-09-2011, 12:48 PM

Hi,

Yeah... I know what you mean. I didn't pull together overnight and I am still making improvements on it.

Here is an updated version with some more comments and added options. Pick and choose what fits your needs:

Sub Generic_Loop_Through_Files()

' Declare the variables
Dim CalcMode                As Long
Dim screenUpdateState       As Variant
Dim statusBarState          As Variant
Dim eventsState             As Variant
Dim fso                     As Object
Dim fpath                   As String

' Use the File system to pick the folder you want. 
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Please Select a Folder"
        .ButtonName = "Select Folder"
        .InitialFileName = "C:\Temp\"          'Change this if you already know where you want to start
        .AllowMultiSelect = False
        .Show
        If .SelectedItems.Count > 0 Then
            fpath = .SelectedItems(1) & "\"
        Else
	   ' If you the user clicks Cancel then give a message and exit the subroutine
            MsgBox "No folder was chosen." & vbLf & vbLf & "Please try again.", vbExclamation, "User Cancelled."
            Exit Sub
        End If
    End With

' Turn off some Excel functionality so your code runs faster
    screenUpdateState = Application.ScreenUpdating
    statusBarState = Application.DisplayStatusBar
    eventsState = Application.EnableEvents

    With Application
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .DisplayStatusBar = False
        .EnableEvents = False
        .DisplayAlerts = False
    End With
    
' Use File System Object to choose folder with files
    Set fso = CreateObject("Scripting.FileSystemObject")
    
'Call the ProcessFolders macro to loop through folders
    Call ProcessFolders(fso, fpath)

' Turn Excel functionality back on
    With Application
        .Calculation = CalcMode
        .ScreenUpdating = screenUpdateState
        .DisplayStatusBar = statusBarState
        .EnableEvents = eventsState
        .Calculation = CalcMode
    End With

MsgBox "Automation completed...", vbInformation

End Sub

Sub ProcessFolders(ByRef fso, ByVal fpath)

' Declare the variables
Dim myFolder, mySubFolder, myFile
Dim wkb                     As Workbook
Dim SavePath                As String
    
' Open each file consequently
    Set myFolder = fso.GetFolder(fpath)

        For Each myFile In myFolder.Files
	 
	' Open only files that look like ".xls*"
            If LCase(myFile.Name) Like "*.xls*" Then  'Currently it is set to look for Excel .xls* files but you can change this to look for any
            
                ' Perform tasks with each file
                    Set wkb = Workbooks.Open(myFile)
                    
                ' First worksheet only - change according to needs
                    With wkb.Worksheets(1)
                    
'*******************************************
'* Add code to do something with each file *
'*******************************************

                    End With
                        
'                'Save file in original folder, but as a different file format (Option 1)
'                   wkb.SaveAs Left(myFile, InStr(1, myFile, ".xls") - 1), xlCSV
                
'                ' Save file in original folder, but as different file format (Option 2)
'                    SavePath = fso.GetFolder(fpath).Name & "\" & fso.GetBaseName(myFile) & ".xls"
'                    wkb.SaveAs fileName:=SavePath, FileFormat:=xlNormal, CreateBackup:=False
                    
                ' Close file (saving = True)
                    wkb.Close savechanges:=True

		' Close the file without saving it
'		    wkb.Close False
            End If

' Loop through all files in folder
        Next myFile
            
' Loop through all subfolders
    For Each mySubFolder In myFolder.SubFolders
        Call ProcessFolders(fso, mySubFolder)
    Next mySubFolder

End Sub

Good luck.

abousetta

**dyesol** · 06-15-2011, 07:07 AM

Thanks abousetta,

I've finished working through and understanding your macro and have canabalised it to suit what I needed to do. It works very well and i'm able to reference mySubFolder to provide the directory for file imports in the macro I had it working on so its helped solve a further problem also!
Excellent!

Thanks once again it has been enormously helpful.

Ben

**snb** · 06-15-2011, 08:23 AM

To get all files in all subfolders of C:\test macro:

Sub snb()
  for each fl in createobject("scripting.filesystemobject").getfolder("C:\test macro").subfolders
    for each fle in fl.files
      c01=fle.name
    next
  next
End Sub

**dyesol** · 06-15-2011, 09:37 AM

ended up as this... added bit to import a text file with MPT suffix present in each sub-folder. In reality there's a whole lot more to do in the loop but this was a good test to get it working.

Sub Generic_Loop_Through_Files1()

' Declare the variables
Dim fso                     As Object
Dim fpath                   As String

' Use the File system to pick the folder you want.
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Please Select a Folder"
        .ButtonName = "Select Folder"
        .InitialFileName = "C:\Temp\"          'Change this if you already know where you want to start
        .AllowMultiSelect = False
        .Show
        If .SelectedItems.Count > 0 Then
            fpath = .SelectedItems(1) & "\"
        Else
       ' If you the user clicks Cancel then give a message and exit the subroutine
            MsgBox "No folder was chosen." & vbLf & vbLf & "Please try again.", vbExclamation, "User Cancelled."
            Exit Sub
        End If
    End With


    
' Use File System Object to choose folder with files
    Set fso = CreateObject("Scripting.FileSystemObject")
    
'Call the ProcessFolders macro to loop through folders
    Call ProcessFolders1(fso, fpath)



MsgBox "Automation completed...", vbInformation

End Sub

Sub ProcessFolders1(ByRef fso, ByVal fpath)

' Declare the variables
Dim myFolder, mySubFolder
    
' Open each file consequently
    Set myFolder = fso.GetFolder(fpath)
            
' Loop through all subfolders
    For Each mySubFolder In myFolder.SubFolders
        Call ProcessFolders1(fso, mySubFolder)
     
     Workbooks.Add

    Dim fMPTname As String
        
    fMPTname = Dir(mySubFolder & "\*.MPT")
    While (Len(fMPTname) > 0)

    Sheets(3).Select
         
        With ActiveSheet.QueryTables.Add(Connection:="TEXT;" _
          & mySubFolder & "\" & fMPTname, Destination:=Range("A1"))
            .Name = "a"
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = 437
            .TextFileStartRow = 1
            .TextFileParseType = xlDelimited
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
            .TextFileConsecutiveDelimiter = True
            .TextFileTabDelimiter = False
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = False
            .TextFileSpaceDelimiter = True
            .TextFileColumnDataTypes = Array(1, 1, 1)
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
            fMPTname = Dir
            Dim Cell    As Range


End With
Wend
        
        
    Next mySubFolder

End Sub

**snb** · 06-15-2011, 10:31 AM

So why don't you:

Sub snb()
  with CreateObject("scripting.filesystemobject")
    for each fl in .getfolder("C:\test macro").subfolders
      for each fle in fl.files
        If .getextensionname(fle) ="MPT" then Workbooks.Open fle , , , 4
      next
    next
  end with
End Sub