VBA递归子过程中数组填充列表框遇下标越界问题求助

问题描述 #

• 递归遍历多子文件夹查找文件时，confListFiles子过程内本地定义的数组，每次子过程迭代都会被重置，导致之前找到的文件数据丢失
• 把计数变量j设为公共变量后，又出现Subscript out of range error（下标越界错误）

原代码 #

Public j As Integer ' In Module
Public folderName As String ' In Module
Public stopCode As Boolean ' In Module

Sub getConf()
Dim firstFolder, confSearchWord As String
Set FSC = CreateObject("Scripting.FileSystemObject")

confSearchWord = dwgText1.Value
j = 0

dataSplit = Split(confSearchWord, "-")
firstFolder = dataSplit(0)
folderName = folderName & "\" & firstFolder '(folderName > In Module)

If FSC.FolderExists(folderName) Then
    Set confFldStart = FSC.GetFolder(folderName)
    confListFolders confFldStart, confSearchWord
Else
    MsgBox "NO FOLDER EXISTS"
End If

End Sub


Sub confListFolders(confFldStart As Object, confSearchWord As String)
Dim conffld As Object
         
For Each conffld In confFldStart.SubFolders
    
        DoEvents
        If stopCode = True Then
            Exit For
            Exit Sub
        End If
                            
        confListFiles conffld, confSearchWord
        confListFolders conffld, confSearchWord
        
    Next

End Sub

Sub confListFiles(conffld As Object, confSearchWord As String)
    Dim fl As Object, FCC As Object
    Dim i As Integer
    Dim strFind As String
    Dim confList() As Variant
            
    Set FCC = CreateObject("Scripting.FileSystemObject")
       
    If conffld.Files.Count <> 0 Then
        ReDim confList(1 To conffld.Files.Count, 1 To 3)
    End If
    
    For Each fl In conffld.Files
    
        DoEvents
        If stopCode = True Then
            Exit For
            Exit Sub
        End If
                              
        If InStr(fl.Name, confSearchWord) Then
            j = j + 1
            confList(j, 1) = fl.Name
            confList(j, 2) = FCC.GetExtensionName(LCase(fl))
            confList(j, 3) = fl.path

            With list2
                .ColumnCount = 2
                .ColumnWidths = "146;20"
                .List = confList
            End With
            
        End If
    Next fl
End Sub

问题根源 #

1. 数组局部作用域：confList是confListFiles的局部变量，每次进入子过程都会重新声明，之前存储的文件数据直接丢失
2. 下标越界原因：每次ReDim confList(1 To conffld.Files.Count, 1 To 3)只分配了当前文件夹的文件数大小，但公共变量j是累计所有符合条件的文件数，当j超过当前文件夹的文件总数时，就会触发下标越界

修改后的代码 #

模块级变量调整 #

Public j As Integer
Public confList() As Variant ' 改为模块级数组，跨子过程共享数据
Public folderName As String
Public stopCode As Boolean

主过程getConf修改 #

Sub getConf()
    Dim firstFolder, confSearchWord As String
    Dim FSC As Object
    Set FSC = CreateObject("Scripting.FileSystemObject")

    confSearchWord = dwgText1.Value
    j = 0
    Erase confList ' 清空上次查询的数组数据

    dataSplit = Split(confSearchWord, "-")
    firstFolder = dataSplit(0)
    folderName = folderName & "\" & firstFolder

    If FSC.FolderExists(folderName) Then
        Set confFldStart = FSC.GetFolder(folderName)
        confListFolders confFldStart, confSearchWord
        ' 所有文件遍历完成后，一次性填充列表框
        With list2
            .ColumnCount = 3 ' 对应数组的3列数据
            .ColumnWidths = "146;20;200" ' 调整宽度显示完整路径
            .List = confList
        End With
    Else
        MsgBox "NO FOLDER EXISTS"
    End If
End Sub

confListFiles子过程修改 #

Sub confListFiles(conffld As Object, confSearchWord As String)
    Dim fl As Object, FCC As Object
    Dim strFind As String
            
    Set FCC = CreateObject("Scripting.FileSystemObject")
       
    For Each fl In conffld.Files
        DoEvents
        If stopCode = True Then
            Exit For
            Exit Sub
        End If
                              
        If InStr(fl.Name, confSearchWord) Then
            j = j + 1
            ' 动态扩展数组大小，保留已有数据
            ReDim Preserve confList(1 To j, 1 To 3)
            confList(j, 1) = fl.Name
            confList(j, 2) = FCC.GetExtensionName(LCase(fl))
            confList(j, 3) = fl.Path
        End If
    Next fl
End Sub

关键修改说明 #

• 把confList改为模块级数组，确保所有子过程调用时共享同一数组，不会丢失之前的数据
• 去掉confListFiles中针对当前文件夹的ReDim，改为找到符合条件的文件时用ReDim Preserve动态扩展数组，数组大小始终和累计的有效文件数一致，彻底避免下标越界
• 将列表框填充操作移到主过程最后，遍历完所有文件夹后一次性赋值，避免每次子过程调用都覆盖列表框内容
• 修正列表框的ColumnCount为3，对应数组的文件名、扩展名、路径三列数据，确保信息完整显示

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