List files in a folder with Microsoft Scripting Runtime
2000-02-04 Files & Folders 0 370
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