listing folder names and sub files

[Yuriy B]

Hi,

Is it possible for excel to list folder names and the contents of all subfolders in excel?

Just like the RUN command that generates the text file list: dir /s >listmyfolder.txt

Thanks

 

[Yuriy B]

Got it to work properly with the following code:

'---------
Public Sub ScanSubfolders()
'---------
Dim FileSystem As Object
Dim HostFolder As String




Range("A1").Value = "Drive"
Range("b1").Value = "Subfolder 1"
Range("c1").Value = "Subfolder 2"
Range("d1").Value = "Subfolder 3"
Range("e1").Value = "Subfolder 4"
Range("f1").Value = "Subfolder 5"
Range("g1").Value = "File Name"
Range("h1").Value = "Modify Date"




Range("A2").Select
HostFolder = "H:"








Set FileSystem = CreateObject("Scripting.FileSystemObject")
DoFolder FileSystem.GetFolder(HostFolder)
End Sub


'---------
Private Sub DoFolder(Folder)
'---------
Dim SubFolder
Dim oFile
Dim LArray() As String					'SET LArray AS STRING
    On Error Resume Next				'IGNORE ALL ERRORS
  
 For Each SubFolder In Folder.SubFolders
           'Debug.Print SubFolder
        DoFolder SubFolder
    Next
    
    For Each oFile In Folder.Files
            ' Operate on each file
       ' Debug.Print Folder, oFile.Name, getFileProperty(oFile, 5)
         If InStr(oFile, ".xls") > 0 Then
         LArray() = Split(Folder, "\")			    'USE SPLIT FUNCTION TO SEPORATE BY DEFINED DELIMITER (\)
            ActiveCell.Value = LArray()                        'DISPLAY DRIVE LETTER ONLY
            ActiveCell.Offset(0, 1).Value = LArray(1)              'DISPLAY NAME OF SUBFOLDER 1
            ActiveCell.Offset(0, 2).Value = LArray(2)                  'DISPLAY NAME OF SUBFOLDER 2
            ActiveCell.Offset(0, 3).Value = LArray(3)                      'DISPLAY NAME OF SUBFOLDER 3
            ActiveCell.Offset(0, 4).Value = LArray(4)                         'DISPLAY NAME OF SUBFOLDER 4
            ActiveCell.Offset(0, 5).Value = LArray(5)                             'DISPLAY NAME OF SUBFOLDER 5
            ActiveCell.Offset(0, 6).Value = oFile.Name                                'DISPLAY NAME OF FILE
            ActiveCell.Offset(0, 7).Value = oFile.DateLastModified                       'DISPLAY FILE MODIFY DATE
            ActiveCell.Offset(1, 0).Select   'next row				             'REPEAT THE PROCESS ONE ROW DOWN
       End If
    Next
End Sub