Question

我遇到了VBA .SubFolders功能的问题。根据我的理解，它应该从主文件夹返回所有子文件夹，但是，当我运行以下代码时，它只返回直接子文件夹：

Sub FileCheck()

Dim issuedFolder As String
Dim subFolder As Object
Dim file As Object

issuedFolder = Application.ActiveWorkbook.Path & "\Issued\"

If Dir(issuedFolder, vbDirectory) <> "" Then

    For Each C In Worksheets("Final Data Set").Range("D2:D1000")
        If C.Value <> "" Then


            For Each subFolder In CreateObject("Scripting.FileSystemObject").GetFolder(issuedFolder).Subfolders
                For Each file In subFolder.Files
                    If (file.Name Like Left(C.Value, InStrRev(C.Value, "_")) & "*") Then
                        MsgBox ("Found: " & Left(C.Value, InStrRev(C.Value, "_")))

                    End If

                Next file

            Next subFolder
        End If

    Next C

End If

End Sub

在我开始向其中添加递归之前，有没有办法调整子文件夹功能以获取这些文件夹的所有子文件夹和所有子文件夹等。

Answer 1

取消我的文件提交：

早期绑定（参考Microsoft Scripting Runtime）

Sub EnumerateFilesAndFolders( _
    FolderPath As String, _
    Optional MaxDepth As Long = -1, _
    Optional CurrentDepth As Long = 0, _
    Optional Indentation As Long = 2)

    Dim FSO As Scripting.FileSystemObject
    Set FSO = New Scripting.FileSystemObject

    'Check the folder exists
    If FSO.FolderExists(FolderPath) Then
        Dim fldr As Scripting.Folder
        Set fldr = FSO.GetFolder(FolderPath)

        'Output the starting directory path
        If CurrentDepth = 0 Then
          Debug.Print fldr.Path
        End If

        'Enumerate the subfolders
        Dim subFldr As Scripting.Folder
        For Each subFldr In fldr.SubFolders
            Debug.Print Space$((CurrentDepth + 1) * Indentation) & subFldr.Name
            If CurrentDepth < MaxDepth Or MaxDepth = -1 Then
                'Recursively call EnumerateFilesAndFolders
                EnumerateFilesAndFolders subFldr.Path, MaxDepth, CurrentDepth + 1, Indentation
            End If
        Next subFldr

        'Enumerate the files
        Dim fil As Scripting.File
        For Each fil In fldr.Files
            Debug.Print Space$((CurrentDepth + 1) * Indentation) & fil.Name
        Next fil
    End If
End Sub

VBA子文件夹功能仅检查1级

1 个答案: