macro loop through all subfolders

Question

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 1

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

Answer 2

Try this version of DoOneFolder:

Sub DoOneFolder(FF As Scripting.Folder)

    Dim F As Scripting.File

    Dim SubF As Scripting.Folder

    Dim WB As Workbook

    For Each F In FF.Files

        Set WB = Workbooks.Open(F.Path)

        ' do something with workbook WB here

        WB.Close SaveChanges:=True

        Debug.Print F.Name

    Next F

    For Each SubF In FF.SubFolders

        DoOneFolder SubF

    Next SubF

End Sub

Answer 3

Your posting was from a long time ago - although I've got the same question:  How to iterate through all the folders in a directory to get all the files in all the folders.

The code you provided bombs out at:

     For Each F in FF

With object doesn't support this property or method.

Are you still around?   If so, do you know how to get the code working?

Answer 4

Replace the line of code

 DoOneFolder FSO, SubF

with

 DoOneFolder SubF

Answer 5

In VBA, go to the Tools menu, choose Reference, and scroll down to and check "Microsoft Scripting Runtime". Then, use code like the following. DoOneFolder is called recursively (that is, it calls itself) to handle any depth of subfolders.

Sub AAA()

    Dim FSO As Scripting.FileSystemObject

    Dim FF As Scripting.Folder

    Set FSO = New Scripting.FileSystemObject

    Set FF = FSO.GetFolder("C:\Your Directory")

    DoOneFolder FF

End Sub

Sub DoOneFolder(FF As Scripting.Folder)

    Dim F As Scripting.File

    Dim SubF As Scripting.Folder

    Dim WB As Workbook

    For Each F In FF

        Set WB = Workbooks.Open(FF.Path)

        ' do something with workbook WB

        WB.Close savechanges:=True

    Next F

    For Each SubF In FF.SubFolders

        DoOneFolder FSO, SubF

    Next SubF

End Sub