查找文件递归并保存在动态数组(VBA)中

时间:2015-02-09 09:19:10

标签: arrays vba

我想在VBA中使用动态数组,以便保存找到的字符串并使用FileSystemObject来查找文件。

我目前使用的代码就是这个

Private Sub cmdStartSearch_Click()
    Dim resultList(0) As String
    Call FindFile(resultList, ".png", "Q:\", True)
End Sub

Private Sub FindFile(ByRef resultList() As String, target As String, ByVal aPath As String, useSubfolders As Boolean)
    Dim myFileSystemObject As FileSystemObject, curFolder As folder, folder As folder
    Dim folColl As Folders, file As file, fileColl As Files
    Set myFileSystemObject = New FileSystemObject
    Set curFolder = myFileSystemObject.GetFolder(aPath)
    Set folderList = curFolder.SubFolders
    Set fileList = curFolder.Files

    For Each file In fileList
        ReDim Preserve resultList(1 To UBound(resultList) + 1) As String
        If InStr(file.Name, target) > 0 Then
            resultList(UBound(resultList)) = file.Name
            Debug.Print file.Name
        End If
    Next

    If useSubfolders Then
        For Each folder In folderList
            DoEvents        'Yield execution so other events may be processed
            If Not foundTarget Then
                 FindFile resultList, target, folder.Path, useSubfolders
            End If
        Next
    End If
    Set myFileSystemObject = Nothing
    Set curFolder = Nothing
    Set folderList = Nothing
    Set fileList = Nothing
End Sub

然而Array is fixed or or temporarily locked失败了。

我如何解决这个问题,或解决原来的问题?

1 个答案:

答案 0 :(得分:0)

我觉得这有一个更好/更容易的解决方案。你所做的是像你一样循环遍历文件列表,然后返回一个带有文件名的长字符串,然后最后使用Split函数将其分解,无论如何都会产生一个String数组。

您的代码可以简单地更改为,

Private Sub cmdStartSearch_Click()
    Dim resultList() As String
    resultList = Split(FindFile(".png", "Q:\", True), ";")
End Sub

Private Function FindFile(target As String, ByVal aPath As String, useSubfolders As Boolean) As String
    Dim retStr As String
    Dim myFileSystemObject As FileSystemObject, curFolder As folder, folder As folder
    Dim folColl As Folders, file As file, fileColl As Files
    Set myFileSystemObject = New FileSystemObject
    Set curFolder = myFileSystemObject.GetFolder(aPath)
    Set folderList = curFolder.SubFolders
    Set fileList = curFolder.Files

    For Each file In fileList
        If InStr(file.Name, target) > 0 Then
            retStr = retStr & ";" & file.Name
            Debug.Print file.Name
        End If
    Next

    If useSubfolders Then
        For Each folder In folderList
            DoEvents        'Yield execution so other events may be processed
            If Not foundTarget Then
                retStr = retStr & ";" & FindFile(target, folder.Path, useSubfolders)
            End If
        Next
    End If

    Set myFileSystemObject = Nothing
    Set curFolder = Nothing
    Set folderList = Nothing
    Set fileList = Nothing

    If Len(retStr) > 0 Then retStr = Right(retStr, Len(retStr)-1)

    FindFile = retStr
End Function

为什么变量 folderList fileList foundTarget 未在上下文中声明?