Note that there are some explanatory texts on larger screens.

plurals
  1. POAdaptive a vba excel function to be recursive
    primarykey
    data
    text
    <p>Im having trouble converting a working solution that takes a directory folder as an input and outputs the filenames and other file attributes of files container in the folder into an excel spreadsheet to a recursive solution that also outputs the files contained in subfolders. I would greatly appreciate any help!</p> <pre><code>Sub GetFileList() Dim strFolder As String Dim varFileList As Variant Dim FSO As Object, myFile As Object Dim myResults As Variant Dim l As Long ' 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 ' Get a list of all the files in this directory. ' Note that this isn't recursive... although it could be... varFileList = fcnGetFileList(strFolder) If Not IsArray(varFileList) Then MsgBox "No files found.", vbInformation Exit Sub End If ' Now let's get all the details for these files ' and place them into an array so it's quick to dump to XL. ReDim myResults(0 To UBound(varFileList) + 1, 0 To 5) ' place make some headers in the array myResults(0, 0) = "Filename" myResults(0, 1) = "Size" myResults(0, 2) = "Created" myResults(0, 3) = "Modified" myResults(0, 4) = "Accessed" myResults(0, 5) = "Full path" Set FSO = CreateObject("Scripting.FileSystemObject") ' Loop through our files For l = 0 To UBound(varFileList) Set myFile = FSO.GetFile(CStr(varFileList(l))) myResults(l + 1, 0) = CStr(varFileList(l)) myResults(l + 1, 1) = myFile.Size myResults(l + 1, 2) = myFile.DateCreated myResults(l + 1, 3) = myFile.DateLastModified myResults(l + 1, 4) = myFile.DateLastAccessed myResults(l + 1, 5) = myFile.Path Next l ' Dump these to a worksheet fcnDumpToWorksheet myResults 'tidy up Set myFile = Nothing Set FSO = Nothing End Sub Private Function fcnGetFileList(ByVal strPath As String, Optional strFilter As String) As Variant ' Returns a one dimensional array with filenames ' Otherwise returns False Dim f As String Dim i As Integer Dim FileList() As String If strFilter = "" Then strFilter = "." Select Case Right$(strPath, 1) Case "\", "/" strPath = Left$(strPath, Len(strPath) - 1) End Select ReDim Preserve FileList(0) f = Dir$(strPath &amp; "\" &amp; strFilter) Do While Len(f) &gt; 0 ReDim Preserve FileList(i) As String FileList(i) = f i = i + 1 f = Dir$() Loop If FileList(0) &lt;&gt; Empty Then fcnGetFileList = FileList Else fcnGetFileList = False End If End Function 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 With sh Range(.Cells(1, 1), .Cells(UBound(varData, 1) + 1, UBound(varData, 2) + 1)) = varData .UsedRange.Columns.AutoFit End With Set sh = Nothing Set wb = Nothing End Sub </code></pre>
    singulars
    1. This table or related slice is empty.
    1. This table or related slice is empty.
    plurals
    1. This table or related slice is empty.
    1. This table or related slice is empty.
    1. This table or related slice is empty.
 

Querying!

 
Guidance

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