Get file names from folder and subfolder function change - excel

Question

i have this code below to get files names from a specific folder and it works great. i like how is transposes the file names it works really well with how i do my work.
what i want to change is to have it also return the file names with in the subfolders to. but carry on transposing it accrss my work sheet.
Thank you.
Function GetFileNames6(ByVal FolderPath As String) As Variant
Dim Result As Variant
Dim i As Integer
Dim MyFile As Object
Dim MyFSO As Object
Dim myFolder As Object
Dim MyFiles As Object
Set MyFSO = CreateObject("Scripting.FileSystemObject")
Set myFolder = MyFSO.GetFolder(FolderPath)
Set MyFiles = myFolder.Files
ReDim Result(1 To MyFiles.Count)
i = 1
o = 1
For Each MyFile In MyFiles
Result(i) = MyFile.name & " " & MyFile.DateCreated
i = i + 1
Next MyFile
GetFileNames6 = Result
End Function

Answer 1

Return File Names From All Folders and Subfolders
Issues
Files containing 'non-standard' characters like e.g. žćčšđ will be returned by the ArrFilePaths function using the WScript Host but will not be found by the FileSystemObject object (nor the Dir function) hence the complications in the GetFileNames6function. If you have such characters in your file- or folder names, you can ask another question.
I've used something like Dim Arr() As String: Arr = Split("") to get an 'empty' string array in both functions. Not sure if that's the ideal way since I've never seen it done before.
Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose: Tests the 'GetFileNames6' function.
' Calls: GetFileNames6
' ArrFilePaths
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub GetFileNames6TEST()
Const FolderPath As String = "C:\Test\"
Dim NamesDates() As String: NamesDates = GetFileNames6(FolderPath)
If UBound(NamesDates) = -1 Then
Debug.Print "No files found."
Exit Sub
End If
Debug.Print Join(NamesDates, vbLf)
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose: Returns a zero-based string array containing the concatenated
' names and dates ('DateCreated') from a given zero-based string
' array containing file paths.
' Calls: ArrFilePaths.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GetFileNames6( _
ByVal FolderPath As String, _
Optional ByVal Delimiter As String = " ") _
As String()
Const ProcName As String = "GetFileNames6"
On Error GoTo ClearError
' Ensuring that a string array is passed if an error occurs.
GetFileNames6 = Split("") ' LB = 0 , UB = -1
Dim FilePaths() As String: FilePaths = ArrFilePaths(FolderPath)
'Debug.Print Join(FilePaths, vbLf)
Dim fso As Object: Set fso = CreateObject("Scripting.FileSystemObject")
Dim fsoFile As Object
Dim n As Long ' Files Count
Dim fCount As Long ' Found Files Count
For n = 0 To UBound(FilePaths)
If fso.FileExists(FilePaths(n)) Then
Set fsoFile = fso.GetFile(FilePaths(n))
FilePaths(fCount) = fsoFile.Name & Delimiter & fsoFile.DateCreated
fCount = fCount + 1
Else ' happens if not 'standard characters' (character map?)
Debug.Print "Not found: " & FilePaths(n)
End If
Next n
If fCount < n Then
ReDim Preserve FilePaths(0 To fCount - 1)
'Debug.Print Join(FilePaths, vbLf)
Debug.Print "Initially found files: " & n
Debug.Print "Finally found files: " & fCount
End If
GetFileNames6 = FilePaths
ProcExit:
Exit Function
ClearError:
Debug.Print "'" & ProcName & "' Run-time error '" _
& Err.Number & "':" & vbLf & " " & Err.Description
Resume ProcExit
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose: Returns the file paths of the files in a folder in an array.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function ArrFilePaths( _
ByVal FolderPath As String, _
Optional ByVal FilePattern As String = "*.*", _
Optional ByVal DirSwitches As String = "/s/b/a-d") _
As String()
Const ProcName As String = "ArrFilePaths"
On Error GoTo ClearError
' Ensuring that a string array is passed if an error occurs.
ArrFilePaths = Split("") ' LB = 0 , UB = -1
Dim pSep As String: pSep = Application.PathSeparator
If Right(FolderPath, 1) <> pSep Then FolderPath = FolderPath & pSep
Dim ExecString As String ' '%comspec%' or 'cmd.exe' ?
ExecString = "%comspec% /c Dir """ _
& FolderPath & FilePattern & """ " & DirSwitches
Dim Arr() As String: Arr = Split(CreateObject("WScript.Shell") _
.Exec(ExecString).StdOut.ReadAll, vbCrLf)
If UBound(Arr) > 0 Then
ReDim Preserve Arr(0 To UBound(Arr) - 1)
End If
ArrFilePaths = Arr
ProcExit:
Exit Function
ClearError:
Debug.Print "'" & ProcName & "' Run-time error '" _
& Err.Number & "':" & vbLf & " " & Err.Description
Resume ProcExit
End Function