Question

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

所以这是主要的目录 - ＆gt;文件夹名称 - ＆gt; SubFolder1 - ＆gt; 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

Answer 1

getSubFolder实现有点奇怪...但你可以简单地添加第二个参数 - 让它称之为Level为整数。从主目录调用该过程时，您可以将其设置为0.在过程中的recursiv调用中，在传递它之前总是将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不允许你像For循环一样退出For循环，所以在使用=返回所需的子文件夹之后我使用了Exit Sub语句retval声明格式。

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

2 个答案: