VBA recursive file listing help to move forward

[AkaTrouble]

i have managed to get so far on a project by reading and copying bits of code

as only new to VBA and learning as i go i have a couple of questions i need some help on

please note lots of the code is copied and put together so if you seen it before sorry

ok the code below does all of the basic stuff to call read and list the files and sub-folders as required and copy them to current worksheet where macro is run from

what i need to do now is learn or have help here to be able to change the fixed start folder (top folder) in code by either asking for folder input or if possible using the windows browse to folder to select this part.

secondly i would like instead of copy result to current sheet on running macro to create a new sheet named as per the folder name selected

and thirdly i have tested code as is and works fine on folders and recursive sub-folders however, i tested it on a large folder of clipart and it returned error. on going to debug window and pushing F5 to continue it did but then returned error again not sure if this is just an array limit because of number of files or an error in the code.

error code = Run-time error '1004' application-defined or object defined error

'Force the explicit delcaration of variables
Option Explicit

Sub ListFiles()

    'Set a reference to Microsoft Scripting Runtime by using
    'Tools > References in the Visual Basic Editor (Alt+F11)
    
    'Declare the variables
    Dim objFSO As Scripting.FileSystemObject
    Dim objTopFolder As Scripting.Folder
    Dim strTopFolderName As String
    
    'Insert the headers for Columns A through F
    Range("A1").Value = "File Name"
    Range("B1").Value = "File Size"
    Range("C1").Value = "File Type"
    Range("D1").Value = "Date Created"
    Range("E1").Value = "Date Last Accessed"
    Range("F1").Value = "Date Last Modified"
    Range("G1").Value = "File Path"
    
    'Assign the top folder to a variable
    strTopFolderName = "C:\Downloads\"
    
    'Create an instance of the FileSystemObject
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    
    'Get the top folder
    Set objTopFolder = objFSO.GetFolder(strTopFolderName)
    
    'Call the RecursiveFolder routine
    Call RecursiveFolder(objTopFolder, True)
    
    'Change the width of the columns to achieve the best fit
    Columns.AutoFit
    
End Sub

Sub RecursiveFolder(objFolder As Scripting.Folder, _
    IncludeSubFolders As Boolean)

    'Declare the variables
    Dim objFile As Scripting.File
    Dim objSubFolder As Scripting.Folder
    Dim NextRow As Long
    
    'Find the next available row
    NextRow = Cells(Rows.Count, "A").End(xlUp).Row + 1
    
    'Loop through each file in the folder
    For Each objFile In objFolder.Files
                Cells(NextRow, "A").Value = objFile.Name
        Cells(NextRow, "B").Value = objFile.Size
        Cells(NextRow, "C").Value = objFile.Type
        Cells(NextRow, "D").Value = objFile.DateCreated
        Cells(NextRow, "E").Value = objFile.DateLastAccessed
        Cells(NextRow, "F").Value = objFile.DateLastModified
        Cells(NextRow, "G").Value = objFile.Path
        NextRow = NextRow + 1
    Next objFile
    
    'Loop through files in the subfolders
    If IncludeSubFolders Then
        For Each objSubFolder In objFolder.SubFolders
            Call RecursiveFolder(objSubFolder, True)
        Next objSubFolder
    End If
    
End Sub

thanks for reading

 

[AkaTrouble]

bump

 

[VBA Geek]

try these modifications

Sub ListFiles()


    'Set a reference to Microsoft Scripting Runtime by using
    'Tools > References in the Visual Basic Editor (Alt+F11)
    
    'Declare the variables
    Dim objFSO As Scripting.FileSystemObject
    Dim objTopFolder As Scripting.Folder
    Dim strTopFolderName As String
   


    
    'Assign the top folder to a variable
[B]    With Application.FileDialog(msoFileDialogFolderPicker)[/B]
[B]        .AllowMultiSelect = False[/B]
[B]        .Title = "Pick a folder"[/B]
[B]        .Show[/B]
[B]        If .SelectedItems.Count = 0 Then MsgBox "Operation Cancelled by the user", vbExclamation + vbOKOnly, "List Files": Exit Sub[/B]
[B]        strTopFolderName = .SelectedItems(1)[/B]
[B]    End With[/B]
    
    ' create a new sheet
[B]    ThisWorkbook.Sheets.Add(after:=Sheets(Sheets.Count)).Name = Mid$(strTopFolderName, InStrRev(strTopFolderName, "\") + 1)[/B]
    
    'Insert the headers for Columns A through F
    Range("A1").Value = "File Name"
    Range("B1").Value = "File Size"
    Range("C1").Value = "File Type"
    Range("D1").Value = "Date Created"
    Range("E1").Value = "Date Last Accessed"
    Range("F1").Value = "Date Last Modified"
    Range("G1").Value = "File Path"
    
    'Create an instance of the FileSystemObject
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    
    'Get the top folder
    Set objTopFolder = objFSO.GetFolder(strTopFolderName)
    
    'Call the RecursiveFolder routine
    Call RecursiveFolder(objTopFolder, True)
    
    'Change the width of the columns to achieve the best fit
    Columns.AutoFit
    
End Sub

 

[AkaTrouble]

Thank You

these modifications seem to work perfectly and achieve the results

thank you seems little to offer in appreciation but i offer respect to and awe of your skill and knowledge