Listing Sub Folders

yinkajewole

Board Regular
Joined
Nov 23, 2018
Messages
245
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?
Code:
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

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
33,967
Office Version
365
Platform
Windows
How about
Code:
[COLOR=#ff0000]Dim FileList() As Variant[/COLOR]


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.ListBox1.List = FileList
End Sub
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
      ReDim Preserve FileList(i)
         FileList(i) = FldrFile
         i = i + 1
   Next FldrFile
   
   If IncludeSubFolders Then
      For Each SubFldr In Fldr.subfolders
         Call RecursiveFolder(FSO, SubFldr, True)
      Next SubFldr
   End If
End Sub
The line in red must go at the very top of the module, before any code
 

yinkajewole

Board Regular
Joined
Nov 23, 2018
Messages
245
How about
Code:
[COLOR=#ff0000]Dim FileList() As Variant[/COLOR]


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.ListBox1.List = FileList
End Sub
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
      ReDim Preserve FileList(i)
         FileList(i) = FldrFile
         i = i + 1
   Next FldrFile
   
   If IncludeSubFolders Then
      For Each SubFldr In Fldr.subfolders
         Call RecursiveFolder(FSO, SubFldr, True)
      Next SubFldr
   End If
End Sub
The line in red must go at the very top of the module, before any code
this line in red brings Compile error: Member already exists in an object module from which this object module derives
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
33,967
Office Version
365
Platform
Windows
In that case try changing the name, like
Code:
Dim MyFileList() As Variant


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.ListBox1.List = MyFileList
End Sub
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
      ReDim Preserve MyFileList(i)
         MyFileList(i) = FldrFile
         i = i + 1
   Next FldrFile
   
   If IncludeSubFolders Then
      For Each SubFldr In Fldr.subfolders
         Call RecursiveFolder(FSO, SubFldr, True)
      Next SubFldr
   End If
End Sub
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
33,967
Office Version
365
Platform
Windows
Have you tried copying & pasting the code I supplied into your file?
 

yinkajewole

Board Regular
Joined
Nov 23, 2018
Messages
245
In that case try changing the name, like
Code:
Dim MyFileList() As Variant


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.ListBox1.List = MyFileList
End Sub
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
      ReDim Preserve MyFileList(i)
         MyFileList(i) = FldrFile
         i = i + 1
   Next FldrFile
   
   If IncludeSubFolders Then
      For Each SubFldr In Fldr.subfolders
         Call RecursiveFolder(FSO, SubFldr, True)
      Next SubFldr
   End If
End Sub
I got it... it works
 

yinkajewole

Board Regular
Joined
Nov 23, 2018
Messages
245
It's just that the file names look too long. Is there anyway the files paths can be shortened?
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
33,967
Office Version
365
Platform
Windows
How do you want to shorten them?
Just show the filename without the path?
 

Forum statistics

Threads
1,086,122
Messages
5,387,972
Members
402,091
Latest member
thomastsiakis

Some videos you may like

This Week's Hot Topics

Top