excel - 从目录和子目录中获取过滤后的文件名列表到数组中

Question

这个问题在这里已经有了答案:





Cycle through sub-folders and files in a user-specified root directory [duplicate]

(3 个回答)


去年关闭。




我用谷歌搜索并找到了很多我正在寻找的结果。读了很多书，现在我的头很痛。因此，仅在这个网站上就有很多关于这个主题的问题，我正在关注这个 question从 2015 年开始。我对其进行了修改以尝试使其与过滤结果一起使用，但这不起作用。它还获取了整个文件路径和文件名，而不仅仅是文件名。由于我对 VBA 的了解并不多，因此有些命令是什么让我有点不知所措。

所以我找到了这个question我喜欢接受的答案。我可以阅读它并轻松地大致了解它发生了什么。问题是它只在当前目录中查找。

应该如何修改它以查看子目录并提取 .xls 文件名列表？

我想我有一种将其过滤为 xls 文件的方法，但也想知道是否有更好的方法。

这是我当前基于第二个问题的代码:

'******************************************************************************
'** LIST DIRECTORY FILES                                                     **
'******************************************************************************
Public Function ListDirectoryFiles(ByVal FileDirectory As String, includeSubs As Boolean) As String()

Dim vaArray()   As String
Dim lCounter    As Long
Dim oFile       As Object
Dim oFSO        As Object
Dim oFolder     As Object
Dim oFiles      As Object

Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(FileDirectory)
Set oFiles = oFolder.Files

If oFiles.Count = 0 Then Exit Function

ReDim vaArray(1 To oFiles.Count)
lCounter = 1
For Each oFile In oFiles
    If Right(oFile.Name, 4) = ".xls" Then
        vaArray(lCounter) = oFile.Name
        lCounter = lCounter + 1
    End If
Next

If lCounter < UBound(vaArray) Then
    ReDim Preserve vaArray(1 To nCounter - 1)
End If

'How to make it look in sub directories
'IF includeSubs then
'     ListDirectoryFiles FileDirectory, true
'     need add the results to vaARRAY somehow so
'     vaARRAY has results from all recursive calls?
ListDirectoryFiles = vaArray

End Function

Answer 1

尝试这个:

 'Return a collection of file objects given a starting folder and a file pattern
    '  e.g. "*.txt"
    'Pass False for last parameter if don't want to check subfolders
    Function GetMatches(startFolder As String, filePattern As String, _
                        Optional subFolders As Boolean = True) As Collection
    
        Dim fso, fldr, f, subFldr
        Dim colFiles As New Collection
        Dim colSub As New Collection
    
        Set fso = CreateObject("scripting.filesystemobject")
        
        colSub.Add startFolder
    
        Do While colSub.Count > 0
    
            Set fldr = fso.getfolder(colSub(1))
            colSub.Remove 1
    
            For Each f In fldr.Files
                'check filename pattern
                If UCase(f.Name) Like UCase(filePattern) Then colFiles.Add f
            Next f
    
            If subFolders Then
                For Each subFldr In fldr.subFolders
                    colSub.Add subFldr.Path
                Next subFldr
            End If
    
        Loop
    
        Set GetMatches = colFiles
    
    End Function

示例用法:

Dim colFiles as Collection, f, wb As Workbook
Set colFiles = GetMatches("C:\something\", "*RENS_RES*.xlsx")
For Each f in colFiles
    Set wb = Workbooks.Open(f.Path)
    'work with wb
    wb.Close False
Next f