capture/return directory and subfolder contents

[r121a947]

I have a thumb drive with several hundred folders and subfolders. The lowest level lists song titles.

I am looking for a way to capture/return the directory contents to a spreadsheet.

Any and all help will be greatly appreciated.

Thanks.

 

[Logit]

The following is a small portion of the total macro coding :

Private Sub btnFetchFiles_Click()
    
    iRow = 14
    fPath = Sheet1.txtPath.Text
    If fPath <> "" Then
        
        Set FSO = New Scripting.FileSystemObject
        If FSO.FolderExists(fPath) <> False Then
            Set SourceFolder = FSO.GetFolder(fPath)
            
            
            If Sheet1.chkBoxIsSubFolder.Value = True Then
                IsSubFolder = True
            Else
                IsSubFolder = False
                If SourceFolder.Files.Count = 0 Then
                    MsgBox "No files exists in this Folder" & vbNewLine & vbNewLine & "Check your folder path and Try Again !!", vbInformation, "File Manager - http://www.LearnExcelMacro.Com"
                    Exit Sub
                End If
            End If
            
            Call ClearResult
            
            If CheckBox1.Value = True Then
            
                Call ListFilesInFolder(SourceFolder, IsSubFolder)
                Call ResultSorting(xlAscending, "C14", "D14", "E14")
            Else
            
                Call ListFilesInFolderXtn(SourceFolder, IsSubFolder)
                Call ResultSorting(xlAscending, "C14", "D14", "E14")
            End If
            
            lblFCount.Caption = iRow - 14
            
        Else
            MsgBox "Selected Path Does Not Exist !!" & vbNewLine & vbNewLine & "Select Correct One and Try Again !!", vbInformation, "File Manager - http://www.LearnExcelMacro.Com"
        End If
    Else
        MsgBox "Folder Path Can not be Empty !!" & vbNewLine & vbNewLine & "", vbInformation, "File Manager - http://www.LearnExcelMacro.Com"
    End If
    
End Sub

 

[r121a947]

I don't understand . . .

Does the code shown work?

Thanks.

 

[Logit]

The attached workbook functions as requested.

 

[r121a947]

I have the following code, which lists the folders and subfolders.

I need it to list the filenames from the subfolders.

Any and all help will be greatly appreciated.

Thanks.

Sub FolderNames()
'Update 20141027
Application.ScreenUpdating = False
Dim xPath As String
Dim xWs As Worksheet
Dim fso As Object, j As Long, folder1 As Object
With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Choose the folder"
    .Show
End With
On Error Resume Next
xPath = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1) & "\"
Application.Workbooks.Add
Set xWs = Application.ActiveSheet
xWs.Cells(1, 1).Value = xPath
xWs.Cells(2, 1).Resize(1, 5).Value = Array("Path", "Dir", "Name", "Date Created", "Date Last Modified")
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder1 = fso.getFolder(xPath)
getSubFolder folder1
xWs.Cells(2, 1).Resize(1, 5).Interior.Color = 65535
xWs.Cells(2, 1).Resize(1, 5).EntireColumn.AutoFit
Application.ScreenUpdating = True
End Sub
Sub getSubFolder(ByRef prntfld As Object)
Dim SubFolder As Object
Dim subfld As Object
Dim xRow As Long
For Each SubFolder In prntfld.SubFolders
    xRow = Range("A1").End(xlDown).Row + 1
    Cells(xRow, 1).Resize(1, 5).Value = Array(SubFolder.Path, Left(SubFolder.Path, InStrRev(SubFolder.Path, "\")), SubFolder.Name, SubFolder.DateCreated, SubFolder.DateLastModified)
Next SubFolder
For Each subfld In prntfld.SubFolders
    getSubFolder subfld
Next subfld
End Sub

 

[Logit]

r121a947

If you take the time to select the various options available shown on the FILE MANAGER worksheet, it will provide the data you
are seeking. There is no need to alter the existing code ... the existing workbook ... or seek another solution.