/build/static/layout/Breadcrumb_cap_w.png

Names of all the folders in a folder Excluding Sub folder

If you want to get the names of all the folders in a directory/folder ( Excluding Sub folders).Try below code-


Sub folder_names_in_a_directory_excluding_subfolder()
Application.ScreenUpdating = False
Dim fldpath
Dim fso As Object, j As Long, folder, SubFolders, SubFolder
    With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Choose the folder"
    .Show
    End With
    On Error Resume Next
    fldpath = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1) & "\"
    If fldpath = False Then
        MsgBox "Folder Not Selected"
    Exit Sub
    End If
    Workbooks.Add
    Cells(1, 1).Value = fldpath
    Cells(2, 1).Value = "Path"
    Cells(2, 2).Value = "Dir"
    Cells(2, 3).Value = "Name"
    Cells(2, 4).Value = "Date Created"
    Cells(2, 5).Value = "Date Last Modified"
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set folder = fso.getfolder(fldpath)
    Set SubFolders = folder.SubFolders
    For Each SubFolder In SubFolders
        j = Range("A1").End(xlDown).Row + 1
        Cells(j, 1).Value = SubFolder.Path
        Cells(j, 2).Value = Left(SubFolder.Path, InStrRev(SubFolder.Path, "\"))
        Cells(j, 3).Value = SubFolder.Name
        Cells(j, 4).Value = SubFolder.DateCreated
        Cells(j, 5).Value = SubFolder.DateLastModified
    Next SubFolder
    Set fso = Nothing
    Range("a1").Font.Size = 9
    ActiveWindow.DisplayGridlines = False
    Range("a3:e" & Range("a2").End(xlDown).Row).Font.Size = 9
    Range("a2:e2").Interior.Color = vbCyan
    Columns("c:h").AutoFit
Application.ScreenUpdating = True
End Sub


Comments

  • May I know for what reason this blog is tagged with Unknown Excel Windows, Microsoft Excel, Microsoft Office Excel, Microsoft Office Excel MUI Italian, Microsoft Office Excel MUI Portuguese Brazil, Scripting, Excel Add-ins - jagadeish 10 years ago
This post is locked
 
This website uses cookies. By continuing to use this site and/or clicking the "Accept" button you are providing consent Quest Software and its affiliates do NOT sell the Personal Data you provide to us either when you register on our websites or when you do business with us. For more information about our Privacy Policy and our data protection efforts, please visit GDPR-HQ