VBA遍历文件夹时ListBox设置List属性报错380/308求助

核心问题 #

1. 递归逻辑错误：每次递归调用searchConf都会执行list2.Clear并重新赋值，导致之前递归找到的结果被覆盖，最终只有最后一次递归的结果（或空值）被显示。
2. 数组维度与控件不匹配：你的list2设置了ColumnCount = 2，但confList是3列数组，赋值时会因为维度不匹配触发错误。
3. 数组填充错误：i的计数逻辑混乱，ReDim confList(1 To SubFolder.Files.Count, 1 To 3)后，循环里只用i作为行索引，导致数组只有第i行有数据，其余行都是空值，List控件无法接受这种不完整的数组。
4. 未初始化数组的情况：当没有找到匹配的文件夹时，confList是空数组，直接赋值给.List会触发错误。

修复后的代码 #

重构递归逻辑，将结果数组通过ByRef传递统一收集数据，最后一次性更新控件：

' 主调用过程
Sub getConf()
    Dim FileSystem As Object
    Dim dataSplit() As String
    Dim firstFolder As String, searchFullName As String
    Dim rootFolder As Object
    Dim confList() As Variant
    
    searchFullName = dwgText1.Value
    dataSplit = Split(searchFullName, "-")
    firstFolder = dataSplit(0)
    
    ' 确保folderName为有效路径（假设已提前定义）
    folderName = folderName & "\" & firstFolder
        
    Set FileSystem = CreateObject("Scripting.FileSystemObject")
    Set rootFolder = FileSystem.GetFolder(folderName)
    
    ' 初始化匹配控件列数的数组
    ReDim confList(1 To 0, 1 To 2)
    ' 递归收集所有匹配文件
    searchConf rootFolder, searchFullName, confList
    
    ' 统一更新List控件
    With list2
        .Clear
        .ColumnCount = 2
        .ColumnWidths = "146;20"
        If UBound(confList) > 0 Then
            .List = confList
        Else
            .AddItem "NO FILES FOUND"
        End If
    End With
End Sub

' 递归搜索过程，ByRef传递结果数组以累积数据
Sub searchConf(Folder As Object, searchName As String, ByRef resultArr As Variant)
    Dim SubFolder As Object
    Dim File As Object
    Dim FSO As Object
    Dim currentRow As Integer
    Dim fileCount As Integer
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    ' 先递归遍历所有子文件夹
    For Each SubFolder In Folder.SubFolders
        searchConf SubFolder, searchName, resultArr
    Next
    
    ' 处理当前匹配的文件夹
    If Folder.Name Like searchName Then
        fileCount = Folder.Files.Count
        If fileCount > 0 Then
            ' 动态扩展数组容量
            ReDim Preserve resultArr(1 To UBound(resultArr) + fileCount, 1 To 2)
            currentRow = UBound(resultArr) - fileCount + 1
            
            ' 填充文件数据到数组
            For Each File In Folder.Files
                resultArr(currentRow, 1) = File.Name
                resultArr(currentRow, 2) = FSO.GetExtensionName(LCase(File.Path))
                currentRow = currentRow + 1
            Next
        End If
    End If
End Sub

关键修复点 #

• 递归传参：通过ByRef传递结果数组，所有递归找到的文件数据都会累积到同一个数组中，不会被中途覆盖。
• 维度匹配：数组定义为2列，与list2的ColumnCount保持一致，避免维度不匹配错误。
• 动态扩容：使用ReDim Preserve扩展数组，确保所有匹配文件都能被存储。
• 统一更新控件：仅在主过程中更新list2，避免递归中反复重置控件导致数据丢失。
• 空数据处理：判断数组是否有有效数据，无匹配时显示提示文本，避免空数组赋值错误。

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