Automatically list all directories from a folder in a worksheet

[RJSIGKITS]

Hi guys.

I need to create a worksheet that, when opened, lists all files in a directory, sorted alphabetically, and ideally to be able to show the date the file was created as well, along with other info pulled from the directory properties. This worksheet will need to be refreshed each time it is opened to check for any newly added directories, and update itself to suit.

The directories are client folders, which are named as per the clients i.d, which is their surname+phone number, eg. 'JOHNS310111'. These each have sub directories such as 'Quotes', 'Order', 'Before', 'After' etc. The directory called 'Order' only gets added when I click a 'Create order' VB button from a different worksheet.

For example, I would need:
Column 'A' to list all directories by name, sorted alpha-numerically (ideally, but not 100% necessary)
Column 'B' to show the date the directory was created
Column 'C' to show if there is a directory inside this directory named 'Order'
Etc...

Is it possible to
1) have an updatable list of directories on a worksheet
2) show information from the directory properties on a worksheet, such as date created etc

any help much appreciated

 

[Yongle]

This is a simple start to get us going
- try this and I will help you amend it
- add the VBA to a new workbook
- amend afolder as required
- save and close workbook
- open it again

Note
- currently only drilling down 1 level
- files and folders combined into single worksheet

Let me know
- how the output wants changing
- do you want option to amend the main folder?

Place in ThisWorkbook module
Private Sub Workbook_Open()
Call Sheet1.ListFoldersAndFiles
End Sub

Put in Sheet Module for Sheet1 (avoid need to refer to the worksheet)

Const afolder = "[COLOR=#ff0000]C:\TestFolder\SubFolder[/COLOR]"
Dim FSO As Object, FLDR As Object, SUBFLDR As Object, aFILE As Object
Dim r As Integer

Sub ListFoldersAndFiles()

'clear old values
Cells.Clear
With Cells(1, 1).Resize(, 3)
    .Value = Array("FOLDER", "FILE", "CREATED")
    .Font.Bold = True
End With

'create instance of File System Object
Set FSO = CreateObject("Scripting.FileSystemObject")
Set FLDR = FSO.GetFolder(afolder)

'main folder & files
    r = GetNextRow
    Cells(r, 1) = FLDR.Name
    Cells(r, 2) = "MAIN FOLDER"
    Cells(r, 3) = FLDR.DateCreated
    Cells(r, 1).Resize(, 3).Font.Bold = True

    For Each aFILE In FLDR.Files
        r = GetNextRow
        Cells(r, 1) = FLDR.Name
        Cells(r, 2) = aFILE.Name
        Cells(r, 3) = aFILE.DateCreated
    Next aFILE

'list subfolders and files
For Each SUBFLDR In FLDR.subfolders
    r = GetNextRow
    Cells(r, 1) = SUBFLDR.Name
    Cells(r, 2) = "SUB-FOLDER"
    Cells(r, 3) = SUBFLDR.DateCreated
    Cells(r, 1).Resize(, 3).Font.Bold = True
    For Each aFILE In SUBFLDR.Files
        r = GetNextRow
        Cells(r, 1) = SUBFLDR.Name
        Cells(r, 2) = aFILE.Name
        Cells(r, 3) = aFILE.DateCreated
    Next aFILE
Next SUBFLDR

End Sub

Private Function GetNextRow()
    GetNextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
End Function