macro loop through all subfolders

I have created a macro that opens all spreadsheets in a folder and pulls the data I need from them.  I need the macro to open all spreadsheets in all subfolders of the directory.  Below is the code I'm using, but I need it to look through each subfolder under "Files".  For example there is a 54, 55, and 56 folder each with multiple spreadsheets in it that I need data from.

 

FolderPath = "H:\Daniel\Files\54\"
     
    FileName = Dir(FolderPath & "*.xl*")
 
    Do While FileName <> ""
    Set WorkBk = Workbooks.Open(FolderPath & FileName)
    
    This is where all the code is to grab the data I need.

                 

    ActiveWorkbook.Close (False)

    FileName = Dir()
  Loop

 

Thanks, Trina

Answer
Answer

See if you can adapt this macro for your purpose:

 

Sub LoopFolders()
    Dim strFolder As String
    Dim strSubFolder As String
    Dim strFile As String
    Dim colSubFolders As New Collection
    Dim varItem As Variant
    Dim wbk As Workbook
    ' Parent folder including trailing backslash
    strFolder = "C:\Excel\Reports\"
    ' Loop through the subfolders and fill Collection object
    strSubFolder = Dir(strFolder & "*", vbDirectory)
    Do While Not strSubFolder = ""
        Select Case strSubFolder
            Case ".", ".."
                ' Current folder or parent folder - ignore
            Case Else
                ' Add to collection
                colSubFolders.Add Item:=strSubFolder, Key:=strSubFolder
        End Select
        ' On to the next one
        strSubFolder = Dir
    Loop
    ' Loop through the collection
    For Each varItem In colSubFolders
        ' Loop through Excel workbooks in subfolder
        strFile = Dir(strFolder & varItem & "\*.xls*")
        Do While strFile <> ""
            ' Open workbook
            Set wbk = Workbooks.Open(Filename:=strFolder & _
                varItem & "\" & strFile, AddToMRU:=False)
            ' Do something with the workbook
            ' ...
            ' Close it
            wbk.Close SaveChanges:=False
            strFile = Dir
        Loop
    Next varItem
End Sub

---
Best wishes, HansV
https://www.eileenslounge.com

4 people found this reply helpful

·

Was this reply helpful?

Sorry this didn't help.

Great! Thanks for your feedback.

How satisfied are you with this reply?

Thanks for your feedback, it helps us improve the site.

How satisfied are you with this reply?

Thanks for your feedback.

 
 

Question Info


Last updated April 13, 2023 Views 13,817 Applies to: