Looking for code to loop through subfolders

[Roli001]

Hi,

I'm looking for a piece of code to loop through subfolders within a folder and open all .csv files.

Appreciate any help.

Thanks,
Roli

Excel 2010

 

[Joe4]

A good start would be to search old posts.

If you go to "Advanced Search", and enter in the Keywords "open files folder" and limit your search to "Search Titles Only" and limit the search to the Excel forum only, you will get about 35 hits. You can refine/change your search as you see fit.

That should get you pointed in the right direction. Post back if you get stuck.

 

[Roli001]

Joe, Thanks for the advice but that's not what I was asking for.

I try helping others by answering their needs not pointing to the search function or Google where you could find anything you're looking for.....that's not the purpose of this forum, is it.

 

[Greg Truby]

Roli,

Firstly - this is totally going to blow Joe's mind because I'm even harsher about expecting members to do a search first and then to post the code they created or found and modified to demonstrate that they have put in a good deal of effort and are not simply expecting to be spoonfed. However, having said that - I just happened to stop by this thread while under the hood of a module that has most of what you're looking for. This will not get you 100% of the way there; but it'll get you about 95% of the way there. All you need to do is play with creating the filespec and the code to loop the variant array that gets returned.

@ Joe - put this in the history books - this is the first time I have *ever* been more generous than you, Mr. NiceGuy!

    '// get an array of the data file names
    '// the function will return a boolean of FALSE if there
    '// are no files that meet the file spec
    Let vntLogDataFiles = fnFileSearch(strPath:=strPath, _
                                       booSearchSubFolders:=False, _
                                       strFileSpec:=strFileSpecLogData)
    If TypeName(vntLogDataFiles) <> "Boolean" Then
        ImportLogData wbLog, eLogType, vntLogDataFiles
        booDirty = True
    End If
    
' _____________________________________________________________________________
' FN FILE SEARCH
' ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
' Descrip:  Absolutely no one can explain how it is that the FileSearch function
'           got deprecated out of Excel in XL2007; but it's out.  So have to
'           write a function that will take its place.
'
'           This version is a synthesis of two versions I found in forums, one
'           at Ozgrid written by Richard and the other on MrExcel, written by Nate.
'
' http://www.ozgrid.com/forum/showthread.php?t=71409&p=369573#post369573
' http://www.mrexcel.com/forum/showthread.php?p=1228168#1253882
'
' Args:     strPath · · · ·         (string)  The path to be searched
'           booSearchSubFolders · · (boolean) Whether or not the function returns subfolders)
'           strFileSpec · · · · · · (string)  The file specification (filter)
'
' Returns:  Variant · · · · · · · · (boolean) FALSE if there are no files that meet this
'                                             file spec.
'                                   (str arr) An array of filenames (or paths & filenames)
'
' Date          Developer   Comments
' ¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨
' 14 Apr 2011   G. Truby    • initial version
' _____________________________________________________________________________
' ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
  Public Function fnFileSearch(ByVal strPath As String, _
                               ByVal booSearchSubFolders As Boolean, _
                               Optional ByVal strFileSpec As String = "*.*") As Variant
' _____________________________________________________________________________
    Const c_strThisProc As String = "fnFileSearch"   '// used by error logging
    Dim strErrMsg As String
    On Error GoTo fnFileSearch_Error
    '··········································································
    
    Const c_lngMaxFiles As Long = 1048576   '// (current max # of rows in a worksheet)
    
    Dim fsoFolder                           As Scripting.Folder, _
        fsoSystemObject                     As Scripting.FileSystemObject, _
        lngFileCount                        As Long, _
        strFileName                         As String, _
        strFileNames(1 To c_lngMaxFiles)    As String, _
        strReturnArr()                      As String, _
        i&
    Let strPath = fnAddPathSeparator(strPath)
        
    Let strFileName = Dir(strPath & strFileSpec)
        
    If Len(strFileName) = 0 Then
        If Not booSearchSubFolders Then
            Let fnFileSearch = False
            Exit Function
        End If
    Else
        Let lngFileCount = 1
        Let strFileNames(lngFileCount) = strPath & strFileName
    End If
    
    Do While Len(strFileName) > 0 _
         And lngFileCount <= c_lngMaxFiles
        Let strFileName = Dir$
        If Len(strFileName) > 0 Then
            lIncrement lngFileCount
            Let strFileNames(lngFileCount) = strPath & strFileName
        End If
    Loop
    
    If booSearchSubFolders Then
        Set fsoSystemObject = New Scripting.FileSystemObject
        Set fsoFolder = fsoSystemObject.GetFolder(strPath)
        FileSearchSubfolders fsoFolder, strFileNames, lngFileCount, strFileSpec
    End If
    
    If lngFileCount = 0 Then
        Let fnFileSearch = False
        Exit Function
    End If
    
    ReDim strReturnArr(LBound(strFileNames) To lngFileCount)
    
    For i = LBound(strReturnArr) To lngFileCount
        Let strReturnArr(i) = strFileNames(i)
    Next i
    
    Let fnFileSearch = strReturnArr
fnFileSearch_EarlyExit:
'¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨
    GoSub CleanUp
    Exit Function
CleanUp:
'¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨
    Erase strFileNames
    Set fsoSystemObject = Nothing
    Set fsoFolder = Nothing
    Return
fnFileSearch_Error:
'¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨
                                                                                
    If Not gc_booDebugMode Then GoSub CleanUp
    
    '// the principle folder being checked is locked, we're dead-ended.
    If Err.Number = 52 Then
        Let fnFileSearch = False
        Exit Function
    End If
        
                                                                   #If Not gccc_UseCentralErrorHandler Then
    CentralErrorHandler strModule:=mc_strThisModule, _
                        strProc:=c_strThisProc, _
                        strExtraErrInfo:=strErrMsg  ' , booEntryPoint:=True
                                                                                                      #Else
    MsgBox "Err #: " & Err.Number & vbCr _
         & Err.Description, vbExclamation, "Error"
                                                                                                    #End If
                        
    If gc_booDebugMode Then
        Stop
        Resume
    End If
End Function '// fn File Search
' _____________________________________________________________________________
' FILE SEARCH SUBFOLDERS
' ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
' Descrip:  Setting this up as a separate sub so that it's easier to call it
'           recursively.  So, yes, it does get called resursively to run through
'           each branch's subfolders.
'
' Args:     fsoFolder · · · (scripting object) the folder to be searched
'           strFileNames()· (string) the array of file names (including path) to
'                           be filled
'           lngFileCount· · the current number of files found
'           strFileSpec · · the [possibly] wild-card containing file specification
'                           being sought
'
' Returns:  n/a, however strFileNames() & lngFileCount will be changed in the
'           calling code since they are passed by reference.
'
' Date          Developer   Comments
' ¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨
' 25 May 2011   G. Truby    • initial version
' _____________________________________________________________________________
' ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
Private Sub FileSearchSubfolders(ByRef fsoFolder As Scripting.Folder, _
                                 ByRef strFileNames() As String, _
                                 ByRef lngFileCount As Long, _
                                 ByRef strFileSpec As String)
' _____________________________________________________________________________
                                 
    Const c_strThisProc As String = "FileSearchSubfolders"   '// used by error logging
    Dim strErrMsg As String
    On Error GoTo FileSearchSubfolders_Error
    '··········································································
    Dim fsoSubFolder    As Scripting.Folder, _
        strFileName     As String, _
        strPath         As String
    For Each fsoSubFolder In fsoFolder.SubFolders
    
        Let strPath = fnAddPathSeparator(fsoSubFolder.Path)
    
        Let strFileName = Dir$(strPath & strFileSpec)
        Do While Len(strFileName) <> 0
            lIncrement lngFileCount
            Let strFileNames(lngFileCount) = strPath & strFileName
            Let strFileName = Dir$
        Loop
        FileSearchSubfolders fsoSubFolder, strFileNames, lngFileCount, strFileSpec
EndOfLoop:
'¨¨¨¨¨¨¨¨¨
    Next fsoSubFolder
    Exit Sub

FileSearchSubfolders_Error:
'¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨¨
    If Err.Number = 52 Then
        lIncrement lngFileCount
        Let strFileNames(lngFileCount) = strPath & "« directory is locked »"
        Resume EndOfLoop
    End If
        
                                                                   #If Not gccc_UseCentralErrorHandler Then
    CentralErrorHandler strModule:=mc_strThisModule, _
                        strProc:=c_strThisProc, _
                        strExtraErrInfo:=strErrMsg  ' , booEntryPoint:=True
                                                                                                      #Else
    MsgBox "Err #: " & Err.Number & vbCr _
         & Err.Description, vbExclamation, "Error"
                                                                                                    #End If
                        
    If gc_booDebugMode Then
        Stop
        Resume
    End If
End Sub '// File Search SubFolders

 

[Greg Truby]

Oh, probably oughtter mention that the above code assumes a reference to the scripting library. If your project doesn't have such a reference, you'd need to go ahead and add one or else edit the code to late bind the objects that pertain to the scripting library.