0

I went through may forum link, I could not get the answer. I am trying to get list of subfolders name under from "D:\today\newtest" folder. Below VBA script using for each loop, it is working perfectly. I am using static binding for both procedures

Sub ListAllSubfolderName()
    Dim oFSO As FileSystemObject
    Dim oFolder As Folder
    Dim vFolder As Variant
    
    Dim sFolderName As String
    
    Set oFSO = New FileSystemObject
    sFolderName = "D:\today\newtest"
    
    If oFSO.FolderExists(sFolderName) Then
        Set oFolder = oFSO.GetFolder(sFolderName)
        For Each vFolder In oFolder.SubFolders
            Debug.Print vFolder.Name
        Next vFolder
    End If
End Sub

When I tried use below VBA script with for loop it is not working. I did not understand what is Subfolders.Item(key) property. How do I use key. I used Subfolders.Item with index number as key. It is giving error. I could not find anywhere in the internet

Sub ListAllSubfolderName_Forloop()
    Dim oFSO As FileSystemObject
    Dim oFolder As Folder
    Dim vFolder As Variant
    Dim iFolderIndex As Integer
    
    Dim sFolderName As String
    
    Set oFSO = New FileSystemObject
    sFolderName = "D:\today\newtest" 
    
    If oFSO.FolderExists(sFolderName) Then
        Set oFolder = oFSO.GetFolder(sFolderName)
        For iFolderIndex = 1 To oFolder.SubFolders.Count
            Debug.Print oFolder.SubFolders.Item(iFolderIndex).Name
        Next iFolderIndex
    End If
End Sub
braX
  • 11,506
  • 5
  • 20
  • 33
Ravi Kannan
  • 303
  • 1
  • 3
  • 11
  • There are lot of code online for recursive folder looping [Here](https://stackoverflow.com/questions/9827715/get-list-of-sub-directories-in-vba) is one such example. There are many more – Siddharth Rout Sep 23 '20 at 08:21
  • 1
    Sorry, I don't understand how your task differs from [this](https://stackoverflow.com/a/22645439/14094617), [this](https://stackoverflow.com/a/14246818/14094617) or [this](https://stackoverflow.com/a/9828013/14094617) one. Perhaps I missed something special? – JohnSUN Sep 23 '20 at 08:23
  • Don't use For by index. To iterate over the elements of the collection, use `For...Each` - see [HERE](https://learn.microsoft.com/en-us/office/vba/language/reference/user-interface-help/folders-collection) – JohnSUN Sep 23 '20 at 08:52

3 Answers3

1

Try this

Sub ListAllSubfolderName_Forloop()
Dim oFSO As FileSystemObject
Dim oFolder As Folder
Dim vFolder As Variant
Dim sfolder As Folder
Dim iFolderIndex As Integer

Dim sFolderName As String

Set oFSO = New FileSystemObject
sFolderName = "C:\DHL Docs"

If oFSO.FolderExists(sFolderName) Then
    Set oFolder = oFSO.GetFolder(sFolderName)
    For Each sfolder In oFolder.SubFolders
        sFolderName = sfolder.Name
    Next sfolder
End If

End Sub

0

oFolder.SubFolders return Folder Collection Object

so, i guess it's bad way to oFolder.SubFolders.Item access with key

Sacru2red
  • 127
  • 1
  • 4
0

This code will give you the list of each subfolders nested in the given folder:

Option Explicit

Sub SubExample()
    Call SubShowFolderList("D:\today\newtest", Range("A1"))
End Sub

Sub SubShowFolderList(StrFolder As String, RngListTop As Range)
    
    'Declarations.
    Dim ObjFileSystem As Object
    Dim ObjFolder As Object
    Dim ObjTarget As Object
    Dim ObjSubFolder As Object
    Dim RngList As Range
    Dim DblRow As Double
    
    'Setting variables.
    DblRow = RngListTop.Row
    Set ObjFileSystem = CreateObject("Scripting.FileSystemObject")
    Set ObjFolder = ObjFileSystem.GetFolder(StrFolder)
    Set ObjSubFolder = ObjFolder.SubFolders
    
    'Covering each subfolder of each given folder and subfolder.
    For Each ObjTarget In ObjSubFolder
        If Left(StrFolder, 1) = "\" Then
            Call SubShowFolderList(StrFolder & ObjTarget.Name, RngListTop)
        Else
            Call SubShowFolderList(StrFolder & "\" & ObjTarget.Name, RngListTop)
        End If
    Next
    
    'Targeting the first blank cell under RngListTop.
    Do Until Excel.WorksheetFunction.CountBlank(RngListTop) = 1
        
        'Checking if the end of the column has been reached.
        If RngListTop.Row = RngListTop.EntireColumn.Rows.Count Then
            If Selection.Address <> RngListTop.Address Then
                RngListTop.Select
                MsgBox "Can't add any other folder", vbCritical, "List is full"
            End If
            Exit Sub
        End If
        
        'Setting variable.
        Set RngListTop = RngListTop.Offset(1, 0)
    Loop
    
    'Filling the range.
    RngListTop.Value = StrFolder
    
    'Setting and sorting the list.
    Set RngList = Range(RngListTop, RngListTop.EntireColumn.Cells(DblRow, 1))
    RngListTop.Parent.Sort.SortFields.Clear
    RngListTop.Parent.Sort.SortFields.Add2 Key:=RngList, _
                                                SortOn:=xlSortOnValues, _
                                                Order:=xlAscending, _
                                                DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Foglio1").Sort
        .SetRange RngList
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
End Sub

It's made by 2 subroutine. The first just calls the second one specifying the desired folder and the cell which will be the top of your list. The subroutine checks if the end of the column has been reached and (if that's not the case) it will sort the list.

Evil Blue Monkey
  • 2,276
  • 1
  • 7
  • 11