StackOverflow2013

Note that there are some explanatory texts on larger screens.

plurals

PO
text
Body
copied!<p>I've rewritten the code to pass your results array and a counter to the recursive function. The function fills the array and calls itself with any subfolders</p> <pre><code>Sub GetFileList() Dim strFolder As String Dim FSO As Object Dim fsoFolder As Object Dim myResults As Variant Dim lCount As Long Set FSO = CreateObject("Scripting.FileSystemObject") ' Get the directory from the user With Application.FileDialog(msoFileDialogFolderPicker) .Show If .SelectedItems.Count = 0 Then Exit Sub 'user cancelled strFolder = .SelectedItems(1) End With Set fsoFolder = FSO.GetFolder(strFolder) 'the variable dimension has to be the second one ReDim myResults(0 To 5, 0 To 0) ' place make some headers in the array myResults(0, 0) = "Filename" myResults(1, 0) = "Size" myResults(2, 0) = "Created" myResults(3, 0) = "Modified" myResults(4, 0) = "Accessed" myResults(5, 0) = "Full path" 'Send the folder to the recursive function FillFileList fsoFolder, myResults, lCount ' Dump these to a worksheet fcnDumpToWorksheet myResults 'tidy up Set FSO = Nothing End Sub Private Sub FillFileList(fsoFolder As Object, ByRef myResults As Variant, ByRef lCount As Long, Optional strFilter As String) Dim i As Integer Dim fsoFile As Object Dim fsoSubFolder As Object Dim fsoSubFolders As Object 'load the array with all the files For Each fsoFile In fsoFolder.Files lCount = lCount + 1 ReDim Preserve myResults(0 To 5, 0 To lCount) myResults(0, lCount) = fsoFile.Name myResults(1, lCount) = fsoFile.Size myResults(2, lCount) = fsoFile.DateCreated myResults(3, lCount) = fsoFile.DateLastModified myResults(4, lCount) = fsoFile.DateLastAccessed myResults(5, lCount) = fsoFile.Path Next fsoFile 'recursively call this function with any subfolders Set fsoSubFolders = fsoFolder.SubFolders For Each fsoSubFolder In fsoSubFolders FillFileList fsoSubFolder, myResults, lCount Next fsoSubFolder End Sub Private Sub fcnDumpToWorksheet(varData As Variant, Optional mySh As Worksheet) Dim iSheetsInNew As Integer Dim sh As Worksheet, wb As Workbook Dim myColumnHeaders() As String Dim l As Long, NoOfRows As Long If mySh Is Nothing Then 'make a workbook if we didn't get a worksheet iSheetsInNew = Application.SheetsInNewWorkbook Application.SheetsInNewWorkbook = 1 Set wb = Application.Workbooks.Add Application.SheetsInNewWorkbook = iSheetsInNew Set sh = wb.Sheets(1) Else Set mySh = sh End If 'since we switched the array dimensions, have to transpose With sh Range(.Cells(1, 1), .Cells(UBound(varData, 2) + 1, UBound(varData, 1) + 1)) = _ Application.WorksheetFunction.Transpose(varData) .UsedRange.Columns.AutoFit End With Set sh = Nothing Set wb = Nothing End Sub </code></pre>

Querying!

Guidance

An individual column

Larger individual text columns get their own page to allow for proper reading.

SQuiL has stopped working due to an internal error.

If you are curious you may find further information in the browser console, which is accessible through the devtools (F12).

Reload