Ignore the files in the last sub folder of the tree

[praveenpatel421983]

Hi,
Before starting the question, just want to let you guys know that I am not expert in excel vba. My knowledge is average.

I am working on creating the list of excel files in the folders and subfolders. I found a macro which can list all the files in the folder and subfolders which is working great without errors but two things which I couldn't figure out is how to make it list only the excel files and ignore the last sub folder of the tree (because last sub folder also contains many excel files which of no use for my other macro which is used to search some data inside the files and hence I want to avoid the last sub folders so that I can save time). For example like the tree below:
______________________Folder1______________________
Folder2''''''''''''''''''''''''''''''''''''''''''Folder3 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''Folder4
Folder5''''''''''''''''''''''''''Folder6______Folder7
"""""""""""""""""""""""""""""""""""""'Folder8

Folder1 ==> Folder2, Folder3, Folder4
Folder2 ==> Folder5
Folder3 ==> Folder6, Folder7
Folder4 ==> (empty)
Folder5 ==> (empty)
Folder6 ==> (empty)
Folder7 ==> Folder8
Folder8 ==> (empty)

Folder1 contains Folder2 (Folder2 contains Folder5), Folder3(Folder3 contains Folder6 and Folder7(Folder7 contains Folder8)) and Folder4 (I have put this in case the spaces above disappears after posting)
Search should ignore Folder4, Folder5, Folder6 and Folder8. I scratched head for long but couldn't find the solution. I always had good support and help from this forum so thought of consulting the experts from this forum, please help.

The program I am using is:

Sub file_names_including_sub_folder()
Application.ScreenUpdating = False
Dim fldpath
Dim fld As Object, fil As Object, fso As Object, j As Long
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Choose the folder"
.Show
End With
On Error Resume Next
fldpath = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1) & ""
If fldpath = False Then
MsgBox "Folder Not Selected"
Exit Sub
End If
Workbooks.Add
Cells(1, 1).Value = fldpath
Cells(2, 1).Value = "Path"
Cells(2, 2).Value = "Dir"
Cells(2, 3).Value = "Name"
Cells(2, 4).Value = "Size"
Cells(2, 5).Value = "Type"
Cells(2, 6).Value = "Date Created"
Cells(2, 7).Value = "Date Last Access"
Cells(2, 8).Value = "Date Last Modified"
Set fso = CreateObject("scripting.filesystemobject")
Set fld = fso.getfolder(fldpath)
j = 4
get_sub_foldernames fld
Range("a1").Font.Size = 9
ActiveWindow.DisplayGridlines = False
Range("a3:h" & Range("a4").End(xlDown).Row).Font.Size = 9
Range("a2:h2").Interior.Color = vbCyan
Columns("c:h").AutoFit
Application.ScreenUpdating = True
End Sub


Sub get_sub_foldernames(ByRef prntfld As Object)
Dim subfld As Object, fil As Object, j As Long
For Each fil In prntfld.Files
j = Range("A1").End(xlDown).Row + 1
Cells(j, 1).Value = fil.Path
Cells(j, 2).Value = Left(fil.Path, InStrRev(fil.Path, ""))
Cells(j, 3).Value = fil.Name
Cells(j, 4).Value = fil.Size
Cells(j, 5).Value = fil.Type
Cells(j, 6).Value = fil.DateCreated
Cells(j, 7).Value = fil.DateLastAccessed
Cells(j, 8).Value = fil.DateLastModified
Next
For Each subfld In prntfld.SubFolders
get_sub_foldernames subfld
Next subfld
End Sub

 

[John_w]

Try this change:

    For Each subfld In prntfld.SubFolders
        If subfld.SubFolders.Count > 0 Then
            get_sub_foldernames subfld
        End If
    Next subfld

 

[praveenpatel421983]

Wow! I didn't realize it is so simple. Thanks John.

Please let me know how to list only excel files and exclude all other file types. I am sure it will be simple but for my level of knowledge I am not able to figure out.

Thanks
Praveen

 

[John_w]

Put one of these If statements within the file loop which outputs the file details:

        If Mid(fil.Name, InStrRev(fil.Name, ".")) Like ".xls*" Then
        If InStr(1, fil.Type, "Excel", vbTextCompare) > 0 Then

 

[praveenpatel421983]

It worked! Thanks a lot John for making my life easy.

You have a wonderful day!
Thanks
Praveen