List files in a folder with Microsoft Scripting Runtime
2000-02-04 Files & Folders 0 5987
Microsoft Scripting Runtime is included in these products: Windows98, Windows2000, IE5, and Office2000. The macro examples below assumes that your VBA project has added a reference to the Microsoft Scripting Runtime library. You can do this from within the VBE by selecting the menu Tools, References... and selecting the Microsoft Scripting Runtime library.
Sub TestListFilesInFolder()
Workbooks.Add ' create a new workbook for the file list
' add headers
With Range("A1")
.Formula = "Folder contents:"
.Font.Bold = True
.Font.Size = 12
End With
Range("A3").Formula = "File Name:"
Range("B3").Formula = "File Size:"
Range("C3").Formula = "File Type:"
Range("D3").Formula = "Date Created:"
Range("E3").Formula = "Date Last Accessed:"
Range("F3").Formula = "Date Last Modified:"
Range("G3").Formula = "Attributes:"
Range("H3").Formula = "Short File Name:"
Range("A3:H3").Font.Bold = True
ListFilesInFolder "C:\FolderName" ' all files in folder
'ListFilesInFolder "C:\FolderName", "*.*", True ' all files, included subfolders
'ListFilesInFolder "C:\FolderName", "*.xl*", True ' all Excel files, included subfolders
End Sub
Sub ListFilesInFolder(SourceFolderName As String, Optional FileFilter As String = "*.*", _
Optional IncludeSubfolders As Boolean = False)
' lists information about the files in SourceFolder
' example: ListFilesInFolder "C:\FolderName", "*.xl*", True
Dim FSO As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder, SubFolder As Scripting.Folder
Dim FileItem As Scripting.File, r As Long
If Len(FileFilter) = 0 Then FileFilter = "*.*"
Set FSO = New Scripting.FileSystemObject
On Error Resume Next
Set SourceFolder = FSO.GetFolder(SourceFolderName)
On Error GoTo 0
If Not SourceFolder Is Nothing Then
r = Range("A65536").End(xlUp).Row
For Each FileItem In SourceFolder.Files
If FileItem.Name Like FileFilter Then
' display file properties
r = r + 1 ' next row number
Cells(r, 1).Formula = FileItem.Path & FileItem.Name
Cells(r, 2).Formula = FileItem.Size
Cells(r, 3).Formula = FileItem.Type
Cells(r, 4).Formula = FileItem.DateCreated
Cells(r, 5).Formula = FileItem.DateLastAccessed
Cells(r, 6).Formula = FileItem.DateLastModified
Cells(r, 7).Formula = FileItem.Attributes
Cells(r, 8).Formula = FileItem.ShortPath & FileItem.ShortName
' use file methods (not proper in this example)
' FileItem.Copy "C:\FolderName\Filename.txt", True
' FileItem.Move "C:\FolderName\Filename.txt"
' FileItem.Delete True
End If
Next FileItem
If IncludeSubfolders Then
For Each SubFolder In SourceFolder.SubFolders
ListFilesInFolder SubFolder.Path, True
Next SubFolder
End If
Columns("A:H").AutoFit
Set FileItem = Nothing
Set SourceFolder = Nothing
End If
Set FSO = Nothing
ActiveWorkbook.Saved = True
End Sub