Listing Sub Folders

[yinkajewole]

I have this code this list the files of a folder into a ListBox called "Filelist". how can i modify the code to include the files in its subfolders?

Function FileArray(Path As String)    Dim Name As String, Counter As Integer, Files() As String
    Name = Dir("C:\Users\USER\Documents\*.xls", vbNormal)
    Counter = 0
    Do While Name > ""
        If Name > "." And Name > ".." Then
            ReDim Preserve Files(Counter)
            Files(Counter) = Name
            Counter = Counter + 1
        End If
        Name = Dir
    Loop
    FileArray = Files()
End Function




Private Sub UserForm_Initialize()
    Dim Files As Variant, NewDocument As Variant, Folder As String
    Folder = "C:\Users\USER\Documents\"  ' ENTER PATH HERE
    Files = FileArray(Folder)
    For Each NewDocument In Files
       FileList.AddItem NewDocument 'ASSUMING U HAVE A LISTBOX FileList IN THE FORM
    Next
End Sub

 

[Fluff]

In the properties window for FileList listbox change the ColumnCount to -1 and then use

Private Sub UserForm_Initialize()
   Dim FSO As Object
   Dim StartFldr As Object
   Dim StartPth As String
   
   StartPth = "C:\Mrexcel"
   Set FSO = CreateObject("Scripting.FileSystemObject")
   Set StartFldr = FSO.getFolder(StartPth)
   Call RecursiveFolder(FSO, StartFldr, True)
   Me.FileList.ColumnWidths = "0;200"
End Sub
Sub RecursiveFolder(FSO As Object, Fldr As Object, IncludeSubFolders As Boolean)
   Dim FldrFile As Object, SubFldr As Object
   
   For Each FldrFile In Fldr.Files
      With Me.FileList
         .AddItem FldrFile
         .List(.ListCount - 1, 1) = FldrFile.Name
      End With
   Next FldrFile
   
   If IncludeSubFolders Then
      For Each SubFldr In Fldr.subfolders
         Call RecursiveFolder(FSO, SubFldr, True)
      Next SubFldr
   End If
End Sub

Private Sub OK_Click()
    Workbooks.Open FileList.Value
End Sub

 

[yinkajewole]

In the properties window for FileList listbox change the ColumnCount to -1 and then use

Private Sub UserForm_Initialize()
   Dim FSO As Object
   Dim StartFldr As Object
   Dim StartPth As String
   
   StartPth = "C:\Mrexcel"
   Set FSO = CreateObject("Scripting.FileSystemObject")
   Set StartFldr = FSO.getFolder(StartPth)
   Call RecursiveFolder(FSO, StartFldr, True)
   Me.FileList.ColumnWidths = "0;200"
End Sub
Sub RecursiveFolder(FSO As Object, Fldr As Object, IncludeSubFolders As Boolean)
   Dim FldrFile As Object, SubFldr As Object
   
   For Each FldrFile In Fldr.Files
      With Me.FileList
         .AddItem FldrFile
         .List(.ListCount - 1, 1) = FldrFile.Name
      End With
   Next FldrFile
   
   If IncludeSubFolders Then
      For Each SubFldr In Fldr.subfolders
         Call RecursiveFolder(FSO, SubFldr, True)
      Next SubFldr
   End If
End Sub

Private Sub OK_Click()
    Workbooks.Open FileList.Value
End Sub

Great!
But I just realised that I displays all files. Where can i modify to make it list only "*.xlsx" files?

 

[Fluff]

Add these two lines as shown

   For Each FldrFile In Fldr.Files
     [COLOR=#ff0000] If FSO.GetExtensionName(FldrFile) Like "xlsx" Then[/COLOR]
         With Me.ListBox1
            .AddItem FldrFile
            .List(.ListCount - 1, 1) = FldrFile.Name
         End With
     [COLOR=#ff0000] End If[/COLOR]
   Next FldrFile

If you want any xl files change the xlsx to xl*

 

[yinkajewole]

Add these two lines as shown

   For Each FldrFile In Fldr.Files
     [COLOR=#ff0000] If FSO.GetExtensionName(FldrFile) Like "xlsx" Then[/COLOR]
         With Me.ListBox1
            .AddItem FldrFile
            .List(.ListCount - 1, 1) = FldrFile.Name
         End With
     [COLOR=#ff0000] End If[/COLOR]
   Next FldrFile

If you want any xl files change the xlsx to xl*

i added it to

[COLOR=#333333][I]Sub RecursiveFolder(FSO As Object, Fldr As Object, IncludeSubFolders As Boolean)[/I][/COLOR]

, it did not to work

 

[yinkajewole]

another issue is that this code

   Dim FSO As Object   Dim StartFldr As Object
   Dim StartPth As String
   
   StartPth = folder_textbox.text & "\"
   Set FSO = CreateObject("Scripting.FileSystemObject")
   Set StartFldr = FSO.getFolder(StartPth)
   Call RecursiveFolder(FSO, StartFldr, True)
   Me.FileList.ColumnWidths = "0;200"

I want it to update each time I change the path through a textbox called "folder_textbox"

 

[Fluff]

Can you please post the code you have for that sub?

 

[yinkajewole]

Can you please post the code you have for that sub?

which of the sub are you talking about?

 

[yinkajewole]

this is how i modified it

Sub RecursiveFolder(FSO As Object, Fldr As Object, IncludeSubFolders As Boolean)
   Dim FldrFile As Object, SubFldr As Object
   
   For Each FldrFile In Fldr.Files
      With Me.FileList
         .AddItem FldrFile
         .List(.ListCount - 1, 1) = FldrFile.Name
      End With
   Next FldrFile
   
   If IncludeSubFolders Then
      For Each SubFldr In Fldr.subfolders
         Call RecursiveFolder(FSO, SubFldr, True)
      Next SubFldr
   End If
    For Each FldrFile In Fldr.Files
      If FSO.GetExtensionName(FldrFile) Like "xls" Then
         With Me.ListBox1
            .AddItem FldrFile
            .List(.ListCount - 1, 1) = FldrFile.Name
         End With
      End If
   Next FldrFile
End Sub

 

[Fluff]

You should have added the two lines in red not the entire code, like

Sub RecursiveFolder(FSO As Object, Fldr As Object, IncludeSubFolders As Boolean)
   Dim FldrFile As Object, SubFldr As Object
   Static i As Long
   
   For Each FldrFile In Fldr.Files
      If FSO.GetExtensionName(FldrFile) Like "xls*" Then
         With Me.ListBox1
            .AddItem FldrFile
            .List(.ListCount - 1, 1) = FldrFile.Name
         End With
      End If
   Next FldrFile
   
   If IncludeSubFolders Then
      For Each SubFldr In Fldr.subfolders
         Call RecursiveFolder(FSO, SubFldr, True)
      Next SubFldr
   End If
End Sub

 

[yinkajewole]

You should have added the two lines in red not the entire code, like

Sub RecursiveFolder(FSO As Object, Fldr As Object, IncludeSubFolders As Boolean)
   Dim FldrFile As Object, SubFldr As Object
   Static i As Long
   
   For Each FldrFile In Fldr.Files
      If FSO.GetExtensionName(FldrFile) Like "xls*" Then
         With Me.ListBox1
            .AddItem FldrFile
            .List(.ListCount - 1, 1) = FldrFile.Name
         End With
      End If
   Next FldrFile
   
   If IncludeSubFolders Then
      For Each SubFldr In Fldr.subfolders
         Call RecursiveFolder(FSO, SubFldr, True)
      Next SubFldr
   End If
End Sub

oh! i see. thanks