The following Excel VBA code can help you to list all files in folder and sub-folders into a worksheet.
Table of Contents
VBA Code
Sub ListAllFilesInAllFolders() Dim MyPath As String, MyFolderName As String, MyFileName As String Dim i As Integer, F As Boolean Dim objShell As Object, objFolder As Object, AllFolders As Object, AllFiles As Object Dim MySheet As Worksheet On Error Resume Next '************************ 'Select folder Set objShell = CreateObject("Shell.Application") Set objFolder = objShell.BrowseForFolder(0, "", 0, 0) If Not objFolder Is Nothing Then MyPath = objFolder.self.Path & "\" Else Exit Sub 'MyPath = "G:\BackUp\" End If Set objFolder = Nothing Set objShell = Nothing '************************ 'List all folders Set AllFolders = CreateObject("Scripting.Dictionary") Set AllFiles = CreateObject("Scripting.Dictionary") AllFolders.Add (MyPath), "" i = 0 Do While i < AllFolders.Count Key = AllFolders.keys MyFolderName = Dir(Key(i), vbDirectory) Do While MyFolderName <> "" If MyFolderName <> "." And MyFolderName <> ".." Then If (GetAttr(Key(i) & MyFolderName) And vbDirectory) = vbDirectory Then AllFolders.Add (Key(i) & MyFolderName & "\"), "" End If End If MyFolderName = Dir Loop i = i + 1 Loop 'List all files For Each Key In AllFolders.keys MyFileName = Dir(Key & "*.*") 'MyFileName = Dir(Key & "*.PDF") 'only PDF files Do While MyFileName <> "" AllFiles.Add (Key & MyFileName), "" MyFileName = Dir Loop Next '************************ 'List all files in Files sheet For Each MySheet In ThisWorkbook.Worksheets If MySheet.Name = "Files" Then Sheets("Files").Cells.Delete F = True Exit For Else F = False End If Next If Not F Then Sheets.Add.Name = "Files" 'Sheets("Files").[A1].Resize(AllFolders.Count, 1) = WorksheetFunction.Transpose(AllFolders.keys) Sheets("Files").[A1].Resize(AllFiles.Count, 1) = WorksheetFunction.Transpose(AllFiles.keys) Set AllFolders = Nothing Set AllFiles = Nothing End Sub
Cloumn A: Directory, Cloumn B: File Name
Line 49
Replace
AllFiles.Add (Key & MyFileName), ""
To
AllFiles.Add (MyFileName), Key
Line 69
Replace
Sheets("Files").[A1].Resize(AllFiles.Count, 1) = WorksheetFunction.Transpose(AllFiles.keys)
To
Sheets("Files").[A1].Resize(AllFiles.Count, 1) = WorksheetFunction.Transpose(AllFiles.Items) Sheets("Files").[B1].Resize(AllFiles.Count, 1) = WorksheetFunction.Transpose(AllFiles.keys)
Others Useful Code
Get File Date
Do While MyFileName <> "" DateStamp = FileDateTime(key & MyFileName) AllFiles.Add (key & MyFileName), DateStamp MyFileName = Dir Loop
Get File Size
Do While MyFileName <> "" MyFileSize = FileLen(Key & MyFileName) AllFiles.Add (MyFileName), MyFileSize MyFileName = Dir Loop
How to Use This Macro
To use this macro, you can copy and paste it into a standard module:
- Activate the Visual Basic Editor by pressing
ALT+F11
. - Right-click the project/workbook name in the Project window.
- Choose
Insert
->Module
.
- Type or paste the code in the newly created module.
- Close the VBE widow.
- Select the range which you want to remove duplicate values.
- On the Developer tab, in the Code group, click Macros.
- Select the macro which you want to run, in this case we select GetUniqueValues, then click Run.
Wow!
Hi there:
Someone at work created a similar worksheet and I’ve asked them for help but they are non responsive. I have not tried your VBA code but am wondering if it will do the following. If not, could you assist me.
I would like the headers main folder / sub folder(s) / date last modified / filename (however I want the filename to be a hyper link to the actual document)
Thank you.
@John Moricone If you won’t take the time to try the code, don’t expect anyone to answer your questions.
@Jim well said Jim
Hi, I want one very simple thing but related to what you have done. please assist.
Code for selecting any excel file previously saved in a given folder and copy that file.
Wow, indeed!
For hottest information you have to pay a quick visit world wide web and on the web I
found this web site as a most excellent site for most recent updates.
WOW thank you been trying to do this all day
This is brilliant and very close to what I am looking for. I am hoping to be able to tweak this to get it to capture a bit more information. If you are able to point me in the right direction I would be very grateful. I can of course manipulate the data post script but I was hoping to do it within the original code.
What I need to achieve is:
All content (i.e. empty folders, system files etc.)
1. Full filepath including filename with extension
2. File name without the extension
3. File extension only
Yes! Yes! 😀
This is what I was looking for and I will shout out your name if and when I finish the QR Code Templates for Powerwall DIYers (need the QR labels for cell identification).
I was able to run the code untouched and afterwards hard code the file path, but if I want to abstract it, then I need first to save the macro (as it was always requesting the folder via dialog box)?
Also, the code “cleans previously ALL cells” in the sheet, but would there be a way to keep the header (A1) since I already changed the cell from where it starts to fill to A2?
Super thanks! Great Code!
Got it 🙂
To keep the first row and start adding filenames from row 2 (or whatever you choose) change lines:
Line 59:
From: Sheets(“Files”).Cells.Delete
To: Sheets(“Files”).Cells.Rows(“2:” & Rows.Count).ClearContents
Line 69:
From: Sheets(“Files”).[A1].Resize(AllFiles.Count, 1) = WorksheetFunction.Transpose(AllFiles.keys)
To: Sheets(“Files”).[A2].Resize(AllFiles.Count, 1) = WorksheetFunction.Transpose(AllFiles.keys)
Not sure if ExcelHowTo agrees 🙂
Very Helpfull. Thank you.