|
Home > Macros > Basics > Files Excel Folder File MacrosUse these macros to list all the files in a specific folder, with file properties, such as file name, size, and creation date.
|
The macros on this page will list all the files or subfolders in a specific folder. See the download section, to get a copy of each of the sample workbooks.
Each file has a worksheet where you'll enter the full path to the folder that you want to document. Then, click a button on the same worksheet, to run a macro that creates the list.
The List Folder File Counts sample file contains 2 macros that list subfolders in the specified folder, with file counts. The sample code, and instructions for running the macros, are below.
-- Macro 1 - Lists Main Folder and Level 1 Subfolders
-- Macro 2 - Main Folder and Levels 1-3 Subfolders
On the MakeList sheet, there are buttons to run the macros
The macros add a new sheet to workbook, with a list of file counts for the main folder and the subfolders
This macro, named ListAllFolders, lists file counts for the main folder, and all first-level subfolders in the specified folder
To run the ListAllFolders macro:
Here is the ListAllFolders code from the sample workbook. To use this code in a different workbook, change the sheet name and range name, in the strPath line, near the top of the code, to match the names in your workbook.
Sub ListAllFolders()
'www.contextures.com
Dim fso As Object
Dim fldrSF As Object
Dim fldr As Object
Dim ofiles As Object
Dim wb As Workbook
Dim wbLinks As Workbook
Dim strPath As String
Dim strMsg As String
Dim strFld As String
Dim lRow As Long
Dim wsZip As Worksheet
Application.DisplayAlerts = False
Application.ScreenUpdating = False
On Error GoTo errHandler
'change sheet and range names
' to match your workbook
strPath = Sheets("MakeList") _
.Range("MainPath").Value
If strPath = "" Then
strMsg = "Please enter a file path " _
& vbCrLf _
& "and try again."
GoTo exitHandler
End If
Set wbLinks = ThisWorkbook
If Right(strPath, 1) <> "\" Then
strPath = strPath & "\"
End If
strMsg = "Could not start the list"
Set wsZip = wbLinks.Sheets.Add
lRow = 4 'leave rows for heading
Set fso = _
CreateObject("Scripting.FileSystemObject")
Set fldrSF = fso.GetFolder(strPath)
strMsg = "Could not count folders"
If Not fldrSF Is Nothing Then
Set ofiles = _
fso.GetFolder(strPath).Files
With wsZip
.Cells(lRow, 2).Value = strPath
.Cells(lRow, 3).Value _
= ofiles.Count
End With
lRow = lRow + 1
For Each fldr In fldrSF.Subfolders
strFld = fldr.Name
Set ofiles = _
fso.GetFolder(strPath _
& strFld).Files
With wsZip
.Cells(lRow, 2).Value _
= strPath & strFld
.Cells(lRow, 3).Value _
= ofiles.Count
End With
lRow = lRow + 1
Next fldr
Else
MsgBox "Could not find main folder"
GoTo exitHandler
End If
With wsZip
With .Cells(1, 1)
.Value = "Subfolders - " & strPath
.Font.Bold = True
.Font.Size = 14
End With
With .Range("B3:C3")
.Value = Array("Folder", "Files")
.Font.Bold = True
End With
.Columns("B:C").EntireColumn.AutoFit
End With
strMsg = "List has been created"
exitHandler:
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox strMsg
Exit Sub
errHandler:
Resume exitHandler
End Sub
This macro, named ListAllFolders3SubFolders, lists file counts for the main folder, and all level 1, 2 and 3 subfolders in the specified folder
To run the macro:
Here is the ListAllFolders3SubFolders code from the sample workbook. To use this code in a different workbook, change the sheet name and range name, in the strPath line, near the top of the code, to match the names in your workbook.
Sub ListAllFolders3SubFolders()
'www.contextures.com
Dim fso As Object
Dim fldr As Object
Dim fldrSF As Object
Dim ofiles As Object
Dim wb As Workbook
Dim wbLinks As Workbook
Dim strPath As String
Dim strMsg As String
Dim strFld As String
Dim lRow As Long
Dim wsZip As Worksheet
Dim fldr2 As Object
Dim fldrSF2 As Object
Dim ofiles2 As Object
Dim strFld2 As String
Dim strPath2 As String
Dim fldr3 As Object
Dim fldrSF3 As Object
Dim ofiles3 As Object
Dim strFld3 As String
Dim strPath3 As String
Application.DisplayAlerts = False
Application.ScreenUpdating = False
On Error GoTo errHandler
'change sheet and range names
' to match your workbook
strPath = Sheets("MakeList") _
.Range("MainPath").Value
If strPath = "" Then
strMsg = "Please enter a file path " _
& vbCrLf _
& "and try again."
GoTo exitHandler
End If
Set wbLinks = ThisWorkbook
If Right(strPath, 1) <> "\" Then
strPath = strPath & "\"
End If
strMsg = "Could not start the list"
Set wsZip = wbLinks.Sheets.Add
lRow = 4 'leave rows for heading
Set fso = _
CreateObject("Scripting.FileSystemObject")
Set fldrSF = fso.GetFolder(strPath)
strMsg = "Could not count folders"
If Not fldrSF Is Nothing Then
Set ofiles = _
fso.GetFolder(strPath).Files
With wsZip
.Cells(lRow, 2).Value = strPath
.Cells(lRow, 3).Value _
= ofiles.Count
End With
lRow = lRow + 1
For Each fldr In fldrSF.Subfolders
strFld = fldr.Name
Set ofiles = _
fso.GetFolder(strPath _
& strFld).Files
With wsZip
.Cells(lRow, 2).Value _
= strPath & strFld
.Cells(lRow, 3).Value _
= ofiles.Count
End With
lRow = lRow + 1
'-----------------------------
For Each fldr2 In fldr.Subfolders
strFld2 = fldr2.Name
strPath2 = strPath & strFld _
& "\" & strFld2
Set ofiles2 = _
fso.GetFolder(strPath2).Files
With wsZip
.Cells(lRow, 2).Value = strPath2
.Cells(lRow, 3).Value _
= ofiles2.Count
End With
lRow = lRow + 1
'-----------------------------
For Each fldr3 In fldr2.Subfolders
strFld3 = fldr3.Name
strPath3 = strPath & strFld _
& "\" & strFld2 _
& "\" & strFld3
Set ofiles3 = _
fso.GetFolder(strPath3).Files
With wsZip
.Cells(lRow, 2).Value = strPath3
.Cells(lRow, 3).Value _
= ofiles3.Count
End With
lRow = lRow + 1
Next fldr3
'-----------------------------
Next fldr2
'-----------------------------
Next fldr
Else
MsgBox "Could not find main folder"
GoTo exitHandler
End If
With wsZip
With .Cells(1, 1)
.Value = "Subfolders - " & strPath
.Font.Bold = True
.Font.Size = 14
End With
With .Range("B3:C3")
.Value = Array("Folder", "Files")
.Font.Bold = True
End With
.Columns("B:C").EntireColumn.AutoFit
End With
strMsg = "List has been created"
exitHandler:
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox strMsg
Exit Sub
errHandler:
Resume exitHandler
End Sub
This sample file contains two macros, which list the file properties
To run the macros:
On the Admin_Settings sheet, you can set:
The List Files button runs the ListFileInfo macro, which lists all the Excel files from folder, with properties as column headings.
This file takes a long time to run, so try it on a folder with just a few files, to see how it works. Reduce the maximum number of properties, if possible, on the Admin_Settings sheet, to make the macro a bit faster.
To see which properties are important to you, run the other macro - List Properties, with one or two sample files. Then, you might decide to show 155 properties, instead of 300 or more.
This macro runs slowly, so reduce the Max Properties setting as low as possible. Test on a small folder first, to see how it works.
The macro checks the file names for a text string - ".xls" - so it should only include Excel files in the list.
Sub ListFileInfo()
'Downloaded from
'www.contextures.com
Dim fso As Object
Dim fldr As Object
Dim file As Object
Dim oFldr As Object
Dim oFile As Object
Dim oShell As Object
Dim wb As Workbook
Dim wbMain As Workbook
Dim wsS As Worksheet
Dim wsL As Worksheet
Dim strPath As String
Dim strMsg As String
Dim strFile As String
Dim rngFldr As Range
Dim lCol As Long
Dim lRow As Long
Dim lRun As Long
Dim lMax As Long
Dim strMsgEnd As String
Dim strFileTest As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
On Error GoTo errHandler
lRun = MsgBox("List info for all files?" _
& vbCrLf _
& "This will take a few minutes.", _
vbYesNo + vbDefaultButton2, "List All Files?")
If lRun <> vbYes Then GoTo exitHandler
Set wbMain = ThisWorkbook
Set wsS = wbMain.Sheets("Setup")
Set rngFldr = wsS.Range("rngFolder")
strFileTest = ".xls"
lMax = wksAS.Range("MaxProp").Value + 1
strPath = rngFldr.Value
strMsgEnd = "Files have been listed"
If Right(strPath, 1) <> "\" Then
strPath = strPath & "\"
End If
strMsg = "Could not create the file path for import"
Set oShell = CreateObject("Shell.Application")
Set fso = CreateObject("Scripting.FileSystemObject")
If strPath <> "" Then
Set fldr = fso.GetFolder(strPath)
Set oFldr = oShell.Namespace(fldr.Path)
Set wsL = Worksheets.Add
With wsL
lCol = 1
lRow = 1
For lCol = 1 To lMax
.Cells(lRow, lCol).Value = lCol - 1
.Cells(lRow + 1, lCol).Value = _
oFldr.GetDetailsOf(oFldr.Items, lCol - 1)
Next lCol
End With
lRow = 3
For Each file In fldr.Files
Set oFile = oFldr.ParseName(file.Name)
lCol = 1
strMsg = "Could not get file info for " & file.Name
strFile = file.Name
If InStr(1, strFile, strFileTest) > 0 Then
With wsL
For lCol = 1 To lMax
.Cells(lRow, lCol).Value = oFldr.GetDetailsOf(oFile, lCol - 1)
Next lCol
End With
lRow = lRow + 1
End If
Next file
End If
MsgBox strMsgEnd
exitHandler:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Exit Sub
errHandler:
MsgBox "Could not update the files"
Resume exitHandler
End Subd
The List Properties button runs the ListExtFileProps macro, which lists property numbers and names at the left, with (optional) sample data from Excel files in the folder
This can help you decide how many properties to include for the List Files macro. In the screen shot below, the list is filtered to hide the blanks in column C. There are dates in properties 153 and 155, but properties after that don't have information that I would need.
This macro lists all the properties (up to your Max), and can include sample data from 1 or 2 sample files. Use this list to decide how many properties to include for the List Files macro.
Sub ListFileInfo()
'Downloaded from
'www.contextures.com
Dim fso As Object
Dim fldr As Object
Dim file As Object
Dim oFldr As Object
Dim oFile As Object
Dim oShell As Object
Dim wb As Workbook
Dim wbMain As Workbook
Dim wsS As Worksheet
Dim wsL As Worksheet
Dim strPath As String
Dim strMsg As String
Dim strFile As String
Dim rngFldr As Range
Dim lCol As Long
Dim lRow As Long
Dim lRun As Long
Dim lMax As Long
Dim strMsgEnd As String
Dim strFileTest As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
On Error GoTo errHandler
lRun = MsgBox("List info for all files?" _
& vbCrLf _
& "This will take a few minutes.", _
vbYesNo + vbDefaultButton2, "List All Files?")
If lRun <> vbYes Then GoTo exitHandler
Set wbMain = ThisWorkbook
Set wsS = wbMain.Sheets("Setup")
Set rngFldr = wsS.Range("rngFolder")
strFileTest = ".xls"
lMax = wksAS.Range("MaxProp").Value + 1
strPath = rngFldr.Value
strMsgEnd = "Files have been listed"
If Right(strPath, 1) <> "\" Then
strPath = strPath & "\"
End If
strMsg = "Could not create the file path for import"
Set oShell = CreateObject("Shell.Application")
Set fso = CreateObject("Scripting.FileSystemObject")
If strPath <> "" Then
Set fldr = fso.GetFolder(strPath)
Set oFldr = oShell.Namespace(fldr.Path)
Set wsL = Worksheets.Add
With wsL
lCol = 1
lRow = 1
For lCol = 1 To lMax
.Cells(lRow, lCol).Value = lCol - 1
.Cells(lRow + 1, lCol).Value = _
oFldr.GetDetailsOf(oFldr.Items, lCol - 1)
Next lCol
End With
lRow = 3
For Each file In fldr.Files
Set oFile = oFldr.ParseName(file.Name)
lCol = 1
strMsg = "Could not get file info for " & file.Name
strFile = file.Name
If InStr(1, strFile, strFileTest) > 0 Then
With wsL
For lCol = 1 To lMax
.Cells(lRow, lCol).Value = oFldr.GetDetailsOf(oFile, lCol - 1)
Next lCol
End With
lRow = lRow + 1
End If
Next file
End If
MsgBox strMsgEnd
exitHandler:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Exit Sub
errHandler:
MsgBox "Could not update the files"
Resume exitHandler
End Subd
This sample file contains two macros that list the files in the specified folder.
For testing, I set up a folder named TestFiles, in the Data folder in the C drive. There a few Excel files, with different formats - xlsm, xlam, and xls. There are other file types too - zipped (zip), Microsoft Access (mdb), Microsoft Word (doc), and text (txt).
Lists all the files in the specified folder, with file size, create date and modified date, from the computer system.
This macro runs quickly, and adds a new sheet to your workbook, with a list of all the files in the specified folder. The file details come from the computer system.
Sub ListAllFiles()
'Downloaded from www.contextures.com
Dim fso As Object
Dim fldr As Object
Dim file As Object
Dim oFldr As Object
Dim oFile As Object
Dim oShell As Object
Dim wb As Workbook
Dim wbMain As Workbook
Dim wsS As Worksheet
Dim wsL As Worksheet
Dim strPath As String
Dim strMsg As String
Dim strFile As String
Dim rngFldr As Range
Dim lRow As Long
Dim lSize As Long
Dim dCont As Date
Dim dCre As Date
Dim dMod As Date
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
On Error GoTo errHandler
Set wbMain = ActiveWorkbook
Set wsS = wbMain.Sheets("Setup")
Set rngFldr = wsS.Range("rngFolder")
strPath = rngFldr.Value
If Right(strPath, 1) <> "\" Then
strPath = strPath & "\"
End If
lRow = 1
strMsg = "Could not create the file path for import"
Set oShell = CreateObject("Shell.Application")
Set fso = CreateObject("Scripting.FileSystemObject")
If strPath <> "" Then
Set fldr = fso.GetFolder(strPath)
Set oFldr = oShell.Namespace(fldr.Path)
Set wsL = Worksheets.Add
With wsL
.Range(.Cells(lRow, 1), .Cells(lRow, 4)).Value = _
Array("FileName", "FileSize", _
"CreateDate", "ModDate")
End With
lRow = 2
For Each file In fldr.Files
Set oFile = oFldr.parsename(file.Name)
strMsg = "Could not get file info for " & file.Name
strFile = file.Name
lSize = file.Size
dCre = file.DateCreated
dMod = file.DateLastModified
With wsL
.Range(.Cells(lRow, 1), .Cells(lRow, 4)).Value = _
Array(strFile, lSize, dCre, dMod)
End With
lRow = lRow + 1
Next file
End If
wsL.Columns("A:D").EntireColumn.AutoFit
exitHandler:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Exit Sub
errHandler:
MsgBox strMsg
Resume exitHandler
End Subd
This macro can take a bit long to run, because it uses property numbers, and the macro occasionally needs to open an Excel file, to get its actual creation date, instead of the Windows date created.
In the file properties list shown above, property 153 is Content Created. That is usually different from the Date Created column, in Windows Explorer. In the macro code, we test for #153, to see if it contains the Content Created date -- this could be different on some computer systems.
If necessary, the macro loops through all the property numbers, to find the correct number. In rare cases, the macro will open the Excel file, to check there for a date, then close the file without saving.
The code also fixes the Content Created date, by removing special characters - 8206 and 8207.
Sub ListExcelFileInfo()
'Downloaded from www.contextures.com
Dim fso As Object
Dim fldr As Object
Dim file As Object
Dim oFldr As Object
Dim oFile As Object
Dim oShell As Object
Dim wb As Workbook
Dim wbMain As Workbook
Dim wsS As Worksheet
Dim wsL As Worksheet
Dim strPath As String
Dim strMsg As String
Dim strFile As String
Dim rngFldr As Range
Dim lRow As Long
Dim lRun As Long
Dim vSize As Variant
Dim vCreX As Variant
Dim dCre As Date
Dim dMod As Date
Dim strFileTest As String
Dim wbFile As Workbook
Dim prop As Variant
Dim lProp As Long
Dim lCont As Long
Dim lContTEST As Long
Dim strCont As String
Dim lCount As Long
Dim lOpen As Long
Dim strBad01 As String
Dim strBad02 As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
On Error GoTo errHandler
lRun = MsgBox("List info for all files?" _
& vbCrLf _
& "This might take a few minutes.", _
vbYesNo + vbDefaultButton2, "Update All?")
If lRun <> vbYes Then GoTo exitHandler
Set wbMain = ActiveWorkbook
Set wsS = wbMain.Sheets("Setup")
Set rngFldr = wsS.Range("rngFolder")
strCont = UCase("Content Created")
lRow = 1
lCont = 0
lContTEST = 153
lCount = 1
strBad01 = ChrW(8206)
strBad02 = ChrW(8207)
strPath = rngFldr.Value
strFileTest = ".xls"
If Right(strPath, 1) <> "\" Then
strPath = strPath & "\"
End If
strMsg = "Could not create the file path for import"
Set oShell = CreateObject("Shell.Application")
Set fso = CreateObject("Scripting.FileSystemObject")
If strPath <> "" Then
Set fldr = fso.GetFolder(strPath)
Set oFldr = oShell.Namespace(fldr.Path)
Set wsL = Worksheets.Add
With wsL
.Range(.Cells(lRow, 1), .Cells(lRow, 5)).Value = _
Array("FileName", "FileSize", _
"CreateDateXL", "CreateDateWin", "ModDate")
End With
lRow = 2
For Each file In fldr.Files
strFile = file.Name
If InStr(1, strFile, strFileTest) > 0 Then
Set oFile = oFldr.parsename(file.Name)
'-------------
If lCount = 1 Then
'get number for Content Created property
If UCase(oFldr.GetDetailsOf(oFldr.items, lContTEST)) _
= strCont Then
lCont = lContTEST
Else
For lProp = 0 To 200
'properties start at zero
On Error Resume Next
If UCase(oFldr.GetDetailsOf(oFldr.items, lProp)) _
= strCont Then
lCont = lProp
Exit For
End If
On Error GoTo errHandler
Next lProp
End If
End If
'-------------
strMsg = "Could not get file info for " & file.Name
vSize = file.Size '/ 1024 ^ 2 'convert bytes to MB
vCreX = ""
dCre = file.DateCreated 'from Windows
dMod = file.DateLastModified
If lCont > 0 Then
vCreX = oFldr.GetDetailsOf(oFile, lCont)
vCreX = Replace(Replace(vCreX, strBad01, ""), strBad02, "")
End If
If vCreX = "" Then
'get creation date from Excel if possible
Set wbFile = Workbooks.Open(strPath & strFile)
On Error Resume Next
vCreX = wbFile _
.BuiltinDocumentProperties("Creation Date").Value
On Error GoTo errHandler
wbFile.Close SaveChanges:=False
Set wbFile = Nothing
lOpen = lOpen + 1
End If
With wsL
.Range(.Cells(lRow, 1), .Cells(lRow, 5)).Value = _
Array(strFile, vSize, vCreX, dCre, dMod)
End With
lRow = lRow + 1
lCount = lCount + 1
End If
Next file
wsL.Columns("A:E").EntireColumn.AutoFit
If lOpen > 0 Then
MsgBox "Number of Excel files opened: " & lOpen
End If
End If
exitHandler:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
Exit Sub
errHandler:
MsgBox "Could not update the files"
Resume exitHandler
End Sub
Get the sample files with these macros:
Last updated: January 26, 2023 2:18 PM
