获取 dir 文件夹名称和最多 2 个子文件夹名称

Question

我想获取目录中文件夹的名称以及该目录中最多 2 层的任何子文件夹的名称。

所以它是 Main Dir -> 文件夹名称 -> SubFolder1 -> SubFolder2

下面的代码获取所有文件夹和子文件夹 Name.I 从 here 获取代码。知道如何限制只有两个子文件夹吗？

Option Explicit

Sub FolderNames()
Application.ScreenUpdating = False
Dim xPath As String
Dim xWs As Worksheet
Dim fso As Object, j As Long, folder1 As Object
With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Choose the folder"
    .Show
End With
On Error Resume Next
xPath = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1) & "\"
Application.Workbooks.Add
Set xWs = Application.ActiveSheet
xWs.Cells(1, 1).Value = xPath
xWs.Cells(2, 1).Resize(1, 5).Value = Array("Path", "Dir", "Name", "Date Created", "Date Last Modified")
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder1 = fso.getFolder(xPath)
getSubFolder folder1
xWs.Cells(2, 1).Resize(1, 5).Interior.Color = 65535
xWs.Cells(2, 1).Resize(1, 5).EntireColumn.AutoFit
Application.ScreenUpdating = True
End Sub
Sub getSubFolder(ByRef prntfld As Object)
Dim SubFolder As Object
Dim subfld As Object
Dim xRow As Long
For Each SubFolder In prntfld.SubFolders
    xRow = Range("A1").End(xlDown).Row + 1
    Cells(xRow, 1).Resize(1, 5).Value = Array(SubFolder.Path, Left(SubFolder.Path, InStrRev(SubFolder.Path, "\")), SubFolder.Name, SubFolder.DateCreated, SubFolder.DateLastModified)
Next SubFolder
For Each subfld In prntfld.SubFolders
    getSubFolder subfld
Next subfld
End Sub

Answer 1

getSubFolder 的实现有点奇怪...但您可以简单地添加第二个参数 - 让我们将其称为 Level as integer。从 Main Dir 调用过程时，您可以将其设置为 0。在过程中的递归调用中，在传递它之前始终将 1 添加到它。所以你总是知道你在哪个级别

Sub getSubFolder(ByRef prntfld As Object, ByVal Level As Integer)
    Dim SubFolder As Object
    Dim subfld As Object
    Dim xRow As Long

    Level = Level + 1
    If Level >= 3 Then Exit Sub

    For Each SubFolder In prntfld.SubFolders
        xRow = Range("A1").End(xlDown).Row + 1
        Cells(xRow, 1).Resize(1, 5).Value = Array(SubFolder.Path, Left(SubFolder.Path, InStrRev(SubFolder.Path, "\")), SubFolder.Name, SubFolder.DateCreated, SubFolder.DateLastModified)

        getSubFolder SubFolder, Level

    Next SubFolder

End Sub

尚未测试，但应该可以。

此处与循环内的 If 语句相同的代码：

Sub getSubFolder(ByRef prntfld As Object, ByVal Level As Integer)
    Dim SubFolder As Object
    Dim subfld As Object
    Dim xRow As Long

    Level = Level + 1

    For Each SubFolder In prntfld.SubFolders
        xRow = Range("A1").End(xlDown).Row + 1
        Cells(xRow, 1).Resize(1, 5).Value = Array(SubFolder.Path, Left(SubFolder.Path, InStrRev(SubFolder.Path, "\")), SubFolder.Name, SubFolder.DateCreated, SubFolder.DateLastModified)
        If Level <= 2 Then getSubFolder SubFolder, Level

    Next SubFolder

End Sub

结果应该是一样的。

Answer 2

我遇到了一个类似的问题，即我想在使用 FolderExists 函数获得我想要的文件夹后停止循环访问其他子文件夹。但是，当我使用 For 循环遍历 FileSystemObject 的子文件夹时，由于 VBA 不允许您像对 While 循环那样退出 For 循环，因此我在返回所需的子文件夹后使用了 Exit Sub 语句通过使用 = retval 语句格式。

获取 dir 文件夹名称和最多 2 个子文件夹名称

Get dir Folder Name and Only Upto 2 Subfolders Name

directory

excel

vba

subdirectory