从文件夹和子文件夹功能更改中获取文件名

Question

我在下面有这段代码可以从特定文件夹中获取文件名，效果很好。我喜欢它是如何转置文件名的，它与我的工作方式非常相配。

我想改变的是让它也return子文件夹中的文件名。但继续将其转换为我的作品 sheet。

谢谢。

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 所有文件夹和子文件夹的文件名

问题

包含 'non-standard' 个字符的文件，例如žćčšđ 将由 ArrFilePaths 函数使用 WScript Host 返回，但不会被 FileSystemObject object（也不是 Dir 函数）找到，因此在GetFileNames6函数。如果您的文件或文件夹名称中有此类字符，您可以再问一个问题。
我在两个函数中都使用了类似 Dim Arr() As String: Arr = Split("") 的方法来获取 'empty' 字符串数组。不确定这是否是理想的方式，因为我以前从未见过它。

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

从文件夹和子文件夹功能更改中获取文件名

Get file names from folder and subfolder function change

excel

vba

file

function

filesystemobject

Return 所有文件夹和子文件夹的文件名