In this VBA sample code I will demonstrate how to get a list of all files in a folder and subfolders and write the output to a sheet together with some other files metrics. I am using 3 subs to do the work, the first modules 'main' runs the program and another sub to get the folders and a sub to get the files.

You will need to add a reference to the Microsoft Scripting Runtine from the tools menu for this script to work. So let's start by opening the VBA editor, ALT+F11 and add the reference then copy the code below and run the 'main' sub.

Dim r As Long


Sub main()
Sheets(1).Select
Sheets(1).Cells(1, 1).Select

With Sheets(1).Range("A1")
.Formula = "Folder contents:"
.Font.Bold = True
.Font.Size = 12
End With

Sheets(1).Range("A3").Formula = "Folder Path:"
Sheets(1).Range("B3").Formula = "Folder Name:"
Sheets(1).Range("C3").Formula = "Size:"
Sheets(1).Range("D3").Formula = "Subfolders:"
Sheets(1).Range("E3").Formula = "Files:"
Sheets(1).Range("F3").Formula = "File Names:"
Sheets(1).Range("A3:G3").Font.Bold = True


' and include subfolders (true/false)
ListFolders "c:\", True

End Sub


Sub ListFolders(SourceFolderName As String, IncludeSubfolders As Boolean)
DoEvents
Application.DisplayAlerts = False

Dim fso As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder, SubFolder As Scripting.Folder


Set fso = New Scripting.FileSystemObject
Set SourceFolder = fso.GetFolder(SourceFolderName)



On Error Resume Next

r = Range("F65536").End(xlUp).Row + 1

Sheets(1).Cells(r, 1).Formula = SourceFolder.Path
Sheets(1).Cells(r, 2).Formula = SourceFolder.Name
Sheets(1).Cells(r, 3).Formula = SourceFolder.Size
Sheets(1).Cells(r, 4).Formula = SourceFolder.SubFolders.Count
Sheets(1).Cells(r, 5).Formula = SourceFolder.Files.Count


r = r + 1
Sheets(1).Cells(r, 1).Select
Findfiles (SourceFolder.Path)


If IncludeSubfolders Then

For Each SubFolder In SourceFolder.SubFolders

ListFolders SubFolder.Path, True

Next SubFolder

Set SubFolder = Nothing
End If

Columns("A:G").AutoFit

Set SourceFolder = Nothing
Set fso = Nothing

End Sub

Sub Findfiles (d As String)

fname = Dir(d & "\*.*")
Do While fname <> ""

Sheets(2).Cells(r, 6).Formula = fname
r = r + 1
fname = Dir
Loop

End Sub
If you like to download an Excel file with this code to save you a bit of time or if you are not experienced with VBA you can get it from here for a small donation of $1.50:
Excel Macro that list all files in folder and subfolders.

Hi i will gladly donate £5.00, if you could assist me with a similar vba code

i need a code to ask for a folder location and then list all the document name, and any custom information added to it like a special log number

and then present the info in the excel sheet being veiwed

cheers

Check your email, I just sent you a reply but I basically said there is an existing Excel file that does just what you want on the Products link on this site.

Sorry no mail received, which is the file you are referring to ?

Humm Yahoo email takes a long time to get there these days. Check this link for the file:

fracta.net/products/index.php?main_page=...b9d82a78d82bcf8e002a

Thanks for the link

but is not the same code as displayed in this post and it only displays the following

Sheets(1).Range("A3").Formula = "Folder Path:"
Sheets(1).Range("B3").Formula = "Folder Name:"
Sheets(1).Range("C3").Formula = "Size:"
Sheets(1).Range("D3").Formula = "Subfolders:"
Sheets(1).Range("E3").Formula = "Files:"
Sheets(1).Range("F3").Formula = "File Names:"


I need it to ask for the location of the directory or folder and then also give the information for the word documents, specifically custom document number

thanks anyway