how to include file system object properties in excel vba dynamic array - arrays

Question

I am trying to work out how to use filesystemobject to include date created, date modified, size, path, file/folder names of files and folders into an excel vba dynamic array so that it automatically expands or contracts to the list of files/folders.
In addition, I am trying to make a list of excluded folder paths so that when I click search, only those folder paths and its files are excluded from the result list, but other folders and its files are shown. Is it possible to make a list of folder paths which will exclude deeper nested folder subfolders?
For example, In this folder C:\test with spaces\ (see image) folder structure I want to exclude the file in C:\test with spaces\subfolder 1\2ndlevelsubfolder1\ including "2ndlevelsubfolder1", but I want all other folders paths to be displayed. How can I do this with vba?
Finally, I also want to make this list recursive, so that every time I add/remove the excluded list of folder paths, new entries will be added right after the previous list. I have these functions made in different excel workbooks but the only problem is incorporating them together into one code. I am showing you my code from 2 workbooks:
This code is for recursive listing:
Option Explicit
Sub SomeSub()
Call GetFiles("\\?\[INSERT PARENT FOLDER PATH HERE]") 'attach "\\?\" at the beginning for long folder path names! ex..'GetFiles("\\?\INSERT..."
'can also list multiple "Call GetFiles("\\?\[insert new folder path here]")" to list multiple folder paths all at once
End Sub
Sub GetFiles(ByVal path As String)
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
Dim folder As Object
Set folder = FSO.GetFolder(path)
Dim SubFolder As Object
Dim file As Object
For Each SubFolder In folder.Subfolders
GetFiles (SubFolder.path)
Next SubFolder
Range("A1") = "parent folder"
'Range("A1").Offset(0, 1) = "FILE/FOLDER PATH"
Range("A1").Offset(0, 3) = "FILE or FOLDER"
Range("A1").Offset(0, 4) = "DATE CREATED"
Range("A1").Offset(0, 5) = "DATE MODIFIED"
Range("A1").Offset(0, 6) = "SIZE"
Range("A1").Offset(0, 7) = "TYPE"
Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = Replace(folder, "\\?\", "")
'Range("A" & Rows.Count).End(xlUp).Offset(0, 1) = Replace(folder, "\\?\", "")
'Range("A" & Rows.Count).End(xlUp).Offset(0, 2) = folder.Name
Range("A" & Rows.Count).End(xlUp).Offset(0, 3) = "FOLDER"
Range("A" & Rows.Count).End(xlUp).Offset(0, 4) = folder.datecreated
Range("A" & Rows.Count).End(xlUp).Offset(0, 5) = folder.DateLastModified
For Each SubFolder In folder.Subfolders
'Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = Replace(subfolder.path, "\\?\", "")
'Range("A" & Rows.Count).End(xlUp).Offset(0, 1) = Replace(folder, "\\?\", "")
'Range("A" & Rows.Count).End(xlUp).Offset(0, 2) = subfolder.Name
'Range("A" & Rows.Count).End(xlUp).Offset(0, 3) = "FOLDER"
'Range("A" & Rows.Count).End(xlUp).Offset(0, 4) = subfolder.datecreated
'Range("A" & Rows.Count).End(xlUp).Offset(0, 5) = subfolder.DateLastModified
Next SubFolder
For Each file In folder.Files
Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = Replace(file.path, "\\?\", "")
'Range("A" & Rows.Count).End(xlUp).Offset(0, 1) = Replace(folder, "\\?\", "")
'Range("A" & Rows.Count).End(xlUp).Offset(0, 2) = file.Name
Range("A" & Rows.Count).End(xlUp).Offset(0, 3) = "FILE"
Range("A" & Rows.Count).End(xlUp).Offset(0, 4) = file.datecreated
Range("A" & Rows.Count).End(xlUp).Offset(0, 5) = file.DateLastModified
Range("A" & Rows.Count).End(xlUp).Offset(0, 6) = file.Size
Range("A" & Rows.Count).End(xlUp).Offset(0, 7) = file.Type
Next file
With Range("E:F")
.NumberFormat = "dddd mmmm dd, yyyy H:mm:ss AM/PM" 'long file date and time
End With
Set FSO = Nothing
Set folder = Nothing
Set SubFolder = Nothing
Set file = Nothing
End Sub
This is the excluded folder name list code in cell A3 only the names are inserted at cell A3 seperated by commas with no spaces after the comma. I want folder paths at any subfolder level to be excluded, not just names at the 1st level
Option Explicit
'http://www.ozgrid.com/forum/showthread.php?t=158478
Dim iRow As Long
Sub ListFiles()
Dim lRow As Long
iRow = 11
lRow = Range("B" & Rows.Count).End(xlUp).Row
If lRow >= iRow Then
Range("B" & iRow & ":E" & Range("B" & Rows.Count).End(xlUp).Row).Clear
End If
Call ListMyFiles(Range("A1"), Range("A2"), Range("A3")) 'Cell A1 is the parent directory, A2 is include subfolders as false or true _
cell A3 is the exclude folder names within the parent directory _
which only works in the 1st level not deeper nested levels
Application.GoTo Range("B3"), True
End Sub
Sub ListMyFiles(mySourcePath As String, IncludeSubfolders As String, _
Optional excludedSubfolders As String = " ")
Dim myObject As Scripting.FileSystemObject
Dim mySource As Scripting.folder, myFile As Variant
Dim myfolder As Variant
Dim iCol As Integer
Dim mySubFolder As Scripting.folder, v As Variant
Dim asf() As String, sf As String
asf() = Split(Replace(excludedSubfolders, ", ", ","), ",")
Set myObject = New Scripting.FileSystemObject
If Right(mySourcePath, 1) <> "\" Then mySourcePath = mySourcePath + "\"
Set mySource = myObject.GetFolder(mySourcePath)
On Error Resume Next
For Each mySubFolder In mySource.SubFolders
iCol = 1
Cells(iRow, iCol).Value = mySubFolder.Path
iCol = iCol + 1
Cells(iRow, iCol).Value = mySubFolder.Name
iRow = iRow + 1
Next mySubFolder
If IncludeSubfolders Then
For Each mySubFolder In mySource.SubFolders
If excludedSubfolders = " " Then
Call ListMyFiles(mySubFolder.Path, True)
Else
sf = Trim(Right(mySubFolder.Path, Len(mySubFolder.Path) - Len(mySourcePath)))
If IndexStrArray(asf(), sf) = -1 Then Call ListMyFiles(mySubFolder.Path, True)
End If
Next
End If
End Sub
'val is not case sensitive
Function IndexStrArray(vArray() As String, sVal As String) As Long
Dim v As Variant, i As Long
On Error GoTo Minus1
For i = 0 To UBound(vArray)
If LCase(vArray(i)) = LCase(sVal) Then
IndexStrArray = i
Exit Function
End If
Next i
Minus1:
IndexStrArray = -1
End Function
I hope this has shed some light on what I want to achieve. Thank you & hope to hear from you soon.

Answer 1

Not sure it'll 100% match your needs.
You should use collections, and recursive sub, like this (not fully tested, it might needs some corrections):
' List of complete path of files in folder / subfolders
' Needs to add "Microsoft Scripting Runtime" reference to your file
Sub FolderFilesPath(ByVal pFolder As String, ByRef pColFiles As Collection, _
Optional ByVal pGetSubFolders As Boolean, Optional ByVal pFilter As Collection)
Dim sFolder As String
Dim oFSO As New FileSystemObject
Dim oFolder, oSubFolder As Folder
Dim oFile As File
sFolder = IIf(Right(pFolder, 1) <> "\", pFolder & "\", pFolder)
Set oFolder = oFSO.GetFolder(sFolder)
If Not ExistsInCollection(pFilter, oFolder) Then
For Each oFile In oFolder.Files
pColFiles.Add oFile
Next oFile
If pGetSubFolders Then
For Each oSubFolder In oFolder.SubFolders
FolderFilesPath oSubFolder.Path, pColFiles, pGetSubFolders,
pFilter
Next
End If
End If
End Sub
' Vba collection contains
Function ExistsInCollection(col As Collection, key As Variant) As Boolean
On Error GoTo err
ExistsInCollection = True
IsObject (col.Item(key))
Exit Function
err:
ExistsInCollection = False
End Function
'------------------------------------------------------------------------------
Sub TestMe()
Dim colFiles As New Collection, sFilePath As Variant
Dim colExcludedFolders As New Collection
With colExcludedFolders
.Add "C:\test with spaces\subfolder 1\"
End With
FolderFilesPath ThisWorkbook.Path, colFiles, True, colExcludedFolders
' colFiles contains filtered files
For Each sFilePath In colFiles
With sFilePath
Debug.Print .Path & " - " & .Name & " - " & .DateCreated
End With
Next sFilePath
End Sub

Answer 2

Now i am getting Run-time error '28': Out of stack space
What is wrong with this code?