Question

我目前有一个VBA函数，它将给定目录中所有子文件夹的名称放入ListBox。打算进一步模块化这个过程，我将它分成一个函数，将子文件夹名称读入一个数组，然后另一个函数用数组内容填充ListBox。

我获取子文件夹名称的代码段如下所示：

Sub FoldernamesToListbox(lookin As String)
    directory = Dir$(lookin & "*.*", vbDirectory)
    Do While Len(directory)
        If directory <> "." And directory <> ".." And GetAttr(lookin & directory) And vbDirectory Then
            MyBox.AddItem directory
        End If
        directory = Dir$()
    Loop
End Sub

为了创建一个将其读入数组的函数，我创建了一个额外的函数来计算子文件夹的数量，与上面的子文件非常相似，以便为数组提供一个大小，从而避免缓慢的＃ 34; ReDim Preserve＆＃34;调用

Function CountFolders(lookinPath As String) As Integer
    j = 0
    directory = Dir$(lookinPath & "*.*", vbDirectory)
    Do While Len(directory)
        If directory <> "." And directory <> ".." And GetAttr(lookinPath & directory) And vbDirectory Then
            j = j + 1
        End If
        directory = Dir$()
    Loop
    CountFolders = j
End Function

但是，当我在新函数中使用计数函数将文件夹名称添加到数组时，函数中的Dir $（）命令似乎有错误：

Sub FoldernamesToArray(lookin As String)
    Dim MyArray() As Variant
    ReDim MyArray(CountFolders(lookin))
    directory = Dir$(lookin & "*.*", vbDirectory)
    j = 0
    Do While Len(directory)
        If directory <> "." And directory <> ".." And GetAttr(lookin & directory) And vbDirectory Then
            j = j + 1
            MyArray(j) = directory
        End If
        directory = Dir$()          'ERROR OCCURS HERE
    Loop
End Sub

由于存在对CountFolders的函数调用，这似乎正在发生。如果我对函数中的数字进行硬编码，它似乎运行正常。 Dir $（）函数或GetAttr导致此问题的属性是什么？

Answer 1

这对我有用：请注意，当您调用CountFolders时，添加或不添加终止\之间存在差异。我添加了一行来处理这个问题。

我不确定你是通过这个分别计算fsub文件夹的appraoch得到任何东西：使用Redim Preserve可能较少开销，而不是在文件夹结构上循环两次。< / p>

Function CountFolders(lookinPath As String) As Integer
    j = 0
    directory = Dir$(lookinPath & "*.*", vbDirectory)
    Do While Len(directory)
        If directory <> "." And directory <> ".." Then
            If GetAttr(lookinPath & directory) And vbDirectory Then
                j = j + 1
            End If
        End If
        directory = Dir$()
    Loop
    Debug.Print lookinPath, j
    CountFolders = j
End Function

Sub FoldernamesToArray(lookin As String)
    Dim MyArray() As Variant

    If Not lookin Like "*\" Then lookin = lookin & "\" '<<added

    ReDim MyArray(1 To CountFolders(lookin))
    directory = Dir$(lookin & "*.*", vbDirectory)
    j = 0
    Do While Len(directory)
        If directory <> "." And directory <> ".." And _
            GetAttr(lookin & directory) And vbDirectory Then
            j = j + 1
            MyArray(j) = directory
        End If
        directory = Dir$()          'ERROR OCCURS HERE
    Loop

    Debug.Print Join(MyArray, ", ")
End Sub

Sub tester()
    FoldernamesToArray "C:\_Stuff\test\"
    FoldernamesToArray "C:\_Stuff\test"
End Sub

使用Dir和GetAttr后重置

1 个答案: