编写VBA函数：输出指定路径含特定字符串的文件及文件夹名称

原代码仅能筛选文件，要同时包含文件夹，需要扩展逻辑，同时遍历目标路径下的文件夹集合和文件集合，以下是修改后的完整代码：

Function GetItemsBySearchString(ByVal FolderPath As String, ByVal SearchString As String) As Variant
    Dim fso As Object
    Dim targetFolder As Object
    Dim resultArr As Variant
    Dim folderArr As Variant
    Dim fileArr As Variant
    Dim i As Integer, j As Integer
    
    ' 初始化FileSystemObject
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set targetFolder = fso.GetFolder(FolderPath)
    
    ' 收集符合条件的文件夹
    ReDim folderArr(1 To targetFolder.SubFolders.Count)
    i = 1
    For Each subFolder In targetFolder.SubFolders
        If InStr(1, subFolder.Name, SearchString, vbTextCompare) <> 0 Then
            folderArr(i) = subFolder.Name & " [文件夹]" ' 标记文件夹，方便区分
            i = i + 1
        End If
    Next subFolder
    ReDim Preserve folderArr(1 To i - 1)
    
    ' 收集符合条件的文件
    ReDim fileArr(1 To targetFolder.Files.Count)
    j = 1
    For Each file In targetFolder.Files
        If InStr(1, file.Name, SearchString, vbTextCompare) <> 0 Then
            fileArr(j) = file.Name & " [文件]" ' 标记文件
            j = j + 1
        End If
    Next file
    ReDim Preserve fileArr(1 To j - 1)
    
    ' 合并文件夹和文件数组
    If i - 1 > 0 And j - 1 > 0 Then
        ReDim resultArr(1 To (i - 1) + (j - 1))
        ' 复制文件夹项
        For i = 1 To UBound(folderArr)
            resultArr(i) = folderArr(i)
        Next i
        ' 复制文件项
        For j = 1 To UBound(fileArr)
            resultArr(i + j - 1) = fileArr(j)
        Next j
    ElseIf i - 1 > 0 Then
        resultArr = folderArr
    ElseIf j - 1 > 0 Then
        resultArr = fileArr
    Else
        ' 无匹配项时返回空数组
        ReDim resultArr(1 To 0)
    End If
    
    GetItemsBySearchString = resultArr
End Function

关键改动说明： #

• 重命名函数和参数为GetItemsBySearchString和SearchString，更贴合实际需求（原参数FileExt容易误导为仅筛选扩展名）
• 新增对SubFolders集合的遍历，筛选名称包含指定字符串的文件夹
• 给文件夹和文件名添加标记（[文件夹]/[文件]），方便在Excel中区分类型
• 使用vbTextCompare实现不区分大小写的搜索（如果需要区分大小写，可移除该参数）
• 处理了无匹配项的边界情况，返回空数组避免报错

使用示例： #

在Excel单元格中输入公式：

=TRANSPOSE(GetItemsBySearchString("C:\你的目标路径", "关键词"))

（用TRANSPOSE可以将数组横向输出为纵向列表）

内容的提问来源于stack exchange，提问作者lost4words2