Open files within sub folders

tasander

Board Regular
Joined
Mar 6, 2009
Messages
67
Hi

I found some code on Mr Excel where it will go into sub folders and get the names of all the files within these folders (see below) but i wanted to know if there was anyway i could amend this so it opens the files up in name or date order?

Private Sub recurseSubFolders(ByRef Folder As Object, ByRef strArr() As String, ByRef i As Long)

Dim SubFolder As Object
Dim strName As String
For Each SubFolder In Folder.SubFolders
Let strName = Dir$(SubFolder.Path & "\*" & "*.xlsx")
Do While strName <> vbNullString
Let i = i + 1
Let strArr(i) = SubFolder.Path & "\" & strName
Let strName = Dir$()
Loop
Call recurseSubFolders(SubFolder, strArr(), i)
Next
End Sub

Many thanks for your help
 

Excel Facts

What did Pito Salas invent?
Pito Salas, working for Lotus, popularized what would become to be pivot tables. It was released as Lotus Improv in 1989.
Maybe something like this...

Code:
[font=Verdana][color=darkblue]Option[/color] [color=darkblue]Explicit[/color]

[color=darkblue]Sub[/color] test()

    [color=darkblue]Dim[/color] objFSO [color=darkblue]As[/color] [color=darkblue]Object[/color]
    [color=darkblue]Dim[/color] objFolder [color=darkblue]As[/color] [color=darkblue]Object[/color]
    [color=darkblue]Dim[/color] wkb [color=darkblue]As[/color] Workbook
    [color=darkblue]Dim[/color] strArray() [color=darkblue]As[/color] [color=darkblue]String[/color]
    [color=darkblue]Dim[/color] strTemp1 [color=darkblue]As[/color] [color=darkblue]String[/color]
    [color=darkblue]Dim[/color] strTemp2 [color=darkblue]As[/color] [color=darkblue]String[/color]
    [color=darkblue]Dim[/color] Cnt [color=darkblue]As[/color] [color=darkblue]Long[/color]
    [color=darkblue]Dim[/color] j [color=darkblue]As[/color] [color=darkblue]Long[/color]
    [color=darkblue]Dim[/color] k [color=darkblue]As[/color] [color=darkblue]Long[/color]
    
    [color=darkblue]Set[/color] objFSO = CreateObject("Scripting.FileSystem[color=darkblue]Object[/color]")
    [color=darkblue]Set[/color] objFolder = objFSO.GetFolder("C:\Users\Domenic\Desktop")  [color=green]'change the path to the main folder, accordingly[/color]
    
    Cnt = 0
    
    [color=darkblue]Call[/color] recurseSubFolders(objFolder, strArray(), Cnt)
    
    [color=green]'Sort array[/color]
    [color=darkblue]For[/color] j = 1 [color=darkblue]To[/color] Cnt - 1
        [color=darkblue]For[/color] k = j + 1 [color=darkblue]To[/color] Cnt
            [color=darkblue]If[/color] strArray(2, j) > strArray(2, k) [color=darkblue]Then[/color]
                strTemp1 = strArray(1, k)
                strTemp2 = strArray(2, k)
                strArray(1, k) = strArray(1, j)
                strArray(2, k) = strArray(2, j)
                strArray(1, j) = strTemp1
                strArray(2, j) = strTemp2
            [color=darkblue]End[/color] [color=darkblue]If[/color]
        [color=darkblue]Next[/color] k
    [color=darkblue]Next[/color] j
    
    [color=green]'Open each file[/color]
    [color=darkblue]For[/color] j = 1 [color=darkblue]To[/color] Cnt
        [color=darkblue]Set[/color] wkb = Workbooks.Open(strArray(1, j))
        [color=green]'Your code here to do stuff[/color]
        wkb.Close savechanges:=[color=darkblue]False[/color]
    [color=darkblue]Next[/color] j
    
[color=darkblue]End[/color] [color=darkblue]Sub[/color]

[color=darkblue]Private[/color] [color=darkblue]Sub[/color] recurseSubFolders([color=darkblue]ByRef[/color] Folder [color=darkblue]As[/color] [color=darkblue]Object[/color], [color=darkblue]ByRef[/color] Arr() [color=darkblue]As[/color] [color=darkblue]String[/color], [color=darkblue]ByRef[/color] i [color=darkblue]As[/color] [color=darkblue]Long[/color])

    [color=darkblue]Dim[/color] SubFolder [color=darkblue]As[/color] Object
    [color=darkblue]Dim[/color] strName [color=darkblue]As[/color] [color=darkblue]String[/color]
    
    [color=darkblue]For[/color] [color=darkblue]Each[/color] SubFolder [color=darkblue]In[/color] Folder.SubFolders
        [color=darkblue]Let[/color] strName = Dir$(SubFolder.Path & "\" & "*.xlsx")
        [color=darkblue]Do[/color] [color=darkblue]While[/color] strName <> vbNullString
            [color=darkblue]Let[/color] i = i + 1
            [color=darkblue]ReDim[/color] [color=darkblue]Preserve[/color] Arr(1 [color=darkblue]To[/color] 2, 1 To i)
            [color=darkblue]Let[/color] Arr(1, i) = [color=darkblue]Sub[/color]Folder.Path & "\" & strName
            [color=darkblue]Let[/color] Arr(2, i) = strName
            [color=darkblue]Let[/color] strName = Dir$()
        [color=darkblue]Loop[/color]
        [color=darkblue]Call[/color] recurseSubFolders(SubFolder, Arr(), i)
    [color=darkblue]Next[/color]
    
[color=darkblue]End[/color] Sub
[/font]
 
Upvote 0
...exactly what I was looking for -thanks!

In my case the specialty is, that each folder can contain multiple files, and I only want to open the newest one. Once I figured that into the code I'll post it here.
 
Upvote 0
There we go, I changed the recursive routine a bit to add the file's folder path as a 3rd and allow reading the file's creation date as a 4th attribute of the array - I am using that in the main routine to only work with the latest file in a folder.

Also looping through files as objects is the more consistent approach in my view, anyway.

In addition I added a quick check to not add the current file to the array in case it's part of the folder structure itself:

Code:
Private Sub recurseSubFolders(ByRef fsoFolder As Object, ByRef Arr() As String, ByRef i As Long)

    Dim fsoSubFolder As Object
    Dim fsoFile As Object
        
    For Each fsoSubFolder In fsoFolder.SubFolders

        For Each fsoFile In fsoSubFolder.Files
             If Not fsoFile.Path = ThisWorkbook.FullName Then
                Let i = i + 1
                ReDim Preserve Arr(1 To 4, 1 To i)
                Let Arr(1, i) = fsoFile.Path 'Full path
                Let Arr(2, i) = fsoSubFolder 'Folder path
                Let Arr(3, i) = fsoFile.Name 'File name
                Let Arr(4, i) = Format(fsoFile.DateCreated, "yyyy-mm-dd") 'Creation date
             End If
        Next

        Call recurseSubFolders(fsoSubFolder, Arr(), i)
    Next
    
End Sub


BTW: I'm not sure why you need to sort the array in the main routine, but the way it's currently done is the least performant method out there ;-)
 
Upvote 0

Forum statistics

Threads
1,222,441
Messages
6,166,052
Members
452,010
Latest member
triangle3

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top