Formula to find allow me to get a list the folder names in a specific directory.

[warren_s]

Hi All,
I have been working on this for awhile now and I am stuck.
I have figured out a formula that will give me a list of files in a specific directory BUT I do not need the file names, I need the directory names.
Does anyone have any clue how to do this?
I would prefer to do it with a formula but if I have to go macro, I will.
Thank you in advance.
Warren

 

[Mister H]

Hi Warren

I am not sure about the formula thing but here is a macro that will do more then you ask but it can be modified. Not sure how experienced you are with macros but with this one you have to set a REFERENCE to "Microsoft Scripting Runtime" ('Tools/References/Microsoft Scriping Runtime)

Option Explicit
Dim lRow As Long
Sub GetBasicFolder()


'Microsoft Scripting Runtime references!
'Tools/References/Microsoft Scriping Runtime
 
    Dim wbkNew                As Workbook
    Dim wksSource             As Worksheet
    Dim sFolderPath           As String
    Set wbkNew = Application.Workbooks.Add(Template:=xlWorksheet)
    Set wksSource = wbkNew.Worksheets(1)
 
    lRow = 3
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .Title = "SELECT the FOLDER that you require a File Listing from and   then      Click OK:"
        .Show
        If .SelectedItems.Count = 0 Then
            Exit Sub
        Else
            sFolderPath = .SelectedItems(1)
        End If
    End With
 
    With wksSource.Range("A1")
        .Value = "The files and subfolders list for " & sFolderPath
            With .Font
                .Bold = True
                .size = 14
                .Underline = True
            End With
                With .Offset(2, 0).Resize(1, 5)
                    .Value = Array("FILENAME", "FOLDER", "FILE PATH", "FILE TYPE", "FILE DATE")
                    .Font.Bold = True
                End With
    End With
    CreateDocList sFolderPath, wksSource
 
End Sub
Sub CreateDocList(ByRef sFolderFullPath As String, _
                  ByVal wksTemp As Excel.Worksheet)
 
'1. Have you checked (marked), a library Microsoft Scripting Runtime
'before starting? (in VBA goto)Tools/References/Microsoft Scripting Runtime - this library must be turn on - otherwise macro will show some errors.
'
    Dim fso                   As FileSystemObject
    Dim objFolder             As Folder
    Dim objSubFolder          As Folder
    Dim objFile               As file
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
 
    Set fso = New FileSystemObject
    Set objFolder = fso.GetFolder(sFolderFullPath)
 
    For Each objFile In objFolder.Files
        If InStr(1, objFile.Type, "Microsoft") Or _
            InStr(1, objFile.Type, "Document") Or _
            InStr(1, objFile.Type, "Text") Then
 
            With wksTemp.Range("A1").Offset(lRow, 0)
                .Value = objFile.Name
                .Hyperlinks.Add Anchor:=.Offset(0, 0), _
                                Address:=objFile.Path, _
                                TextToDisplay:=.Text
                 .Offset(0, 1) = objFolder.Name
                 .Offset(0, 2) = objFile.Path
                 .Offset(0, 3) = objFile.Type
                 .Offset(0, 4) = objFile.DateCreated
 
            End With
                    lRow = lRow + 1
        End If
    Next objFile
    For Each objSubFolder In objFolder.SubFolders
        CreateDocList objSubFolder.Path, wksTemp
    Next objSubFolder
 
    With wksTemp
        .Columns("B:E").AutoFit
        .Range("A:A").ColumnWidth = 47
    End With
 
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
 
    Set fso = Nothing
    Set objFolder = Nothing
    Set objSubFolder = Nothing
    Set objFile = Nothing
End Sub

Good Luck with your project
Mark