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

【问题标题】：Get dir Folder Name and Only Upto 2 Subfolders Name获取 dir 文件夹名称和最多 2 个子文件夹名称
【发布时间】：2016-03-01 01:00:31
【问题描述】：

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

所以它是主目录 -> 文件夹名称 -> SubFolder1 -> SubFolder2

下面的代码获取所有文件夹和子文件夹名称。我从 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

【问题讨论】：

所以您选择了一个解决方案并要求我们根据您的目标对其进行修改？你的努力在哪里？请与我们分享您已经尝试过什么以及为什么不起作用？
该代码完全是多余的，并且对于遍历子文件夹非常慢。但在回答您的问题时 - 为什么不直接运行您拥有的代码并过滤结果为 4 "``" 或更少？
@MacroMan 这是个好主意。我会努力实现的。

标签： vba excel directory subdirectory

【解决方案1】：

getSubFolder 的实现有点奇怪......但您可以简单地添加第二个参数 - 我们将其称为 Level 为整数。从 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

结果应该是一样的。

【讨论】：

If 语句不应该在 For 循环中吗？
您也可以将其放入其中，但随后调用 getSubFolder 而不是 Exit Sub ...但是您还必须更改 If 条件
试过它说 Argument not optional :/ 在主 Sub 中调用 getSubFolder 文件夹1
正如我所说：从主目录调用时，您必须将 0 作为 Level 传递
sorry ...上面的代码有错误... Level的增加必须在循环之外。在代码中修复了这个问题

【解决方案2】：

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

【讨论】：