Hi,
This works for me and you should be able to easily adapt this for your
purpose
You need to have a reference to Microsoft Scripting Runtime
Dim FoldName As String
Sub aListFilesInFolder()
' Adding a 1 here will include sub folders
IncSub = 1
' the folder name you want to search
FoldName = "C:\My Documents"
Workbooks.Add
Range("A1") = "File Name"
Range("B1") = "Modified"
Range("C1") = "Accessed"
Range("D1") = "Created"
Range("E1") = "Size"
Range("F1") = "Path"
Range("G1") = "Type"
Range("A1:G1").Font.Bold = True
Application.DisplayAlerts = False
If IncSub = 1 Then
ListFilesInFolder FoldName, True
Else
ListFilesInFolder FoldName, False
End If
Range("B
").HorizontalAlignment = xlCenter
Range("E1").HorizontalAlignment = xlRight
Columns("A:G").AutoFit
End Sub
Sub ListFilesInFolder(SourceFolderName As String, IncludeSubfolders As
Boolean)
' Lists information about the files in SourceFolder
' Example: ListFilesInFolder "C:\FolderName\", True
Dim FSO As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder, SubFolder As
Scripting.Folder
Dim FileItem As Scripting.File
Dim r As Long
Set FSO = New Scripting.FileSystemObject
Set SourceFolder = FSO.GetFolder(SourceFolderName)
' Any folder we want to miss must be declared here ...
t1 = SourceFolder
' The following hidden folders cause an error so we exclude them
If t1 = FoldName & "System Volume Information" _
Or Left(t1, 8) = FoldName & "RECYC" Then GoTo End_Loop
r = Range("A65536").End(xlUp).Row + 1
For Each FileItem In SourceFolder.Files
On Error GoTo No_Add
Cells(r, 1).Formula = FileItem.Name
Cells(r, 2).Formula = FileItem.DateLastModified
Cells(r, 3).Formula = FileItem.DateLastAccessed
Cells(r, 4).Formula = FileItem.DateCreated
With Cells(r, 5)
.Formula = Int(FileItem.Size / 1024) & " KB"
.HorizontalAlignment = xlRight
End With
x = Len(FileItem.Name)
y = Len(FileItem.Path)
Cells(r, 6).Formula = Mid(FileItem.Path, 1, y - x)
Application.StatusBar = "Checking " & Mid(FileItem.Path, 1, y -
x)
Cells(r, 7).Formula = FileItem.Type
r = r + 1 ' next row number
No_Add:
Next FileItem
Miss_Loop:
' Include sub folders if requested by user
If IncludeSubfolders Then
For Each SubFolder In SourceFolder.SubFolders
ListFilesInFolder SubFolder.Path, True
Next SubFolder
End If
End_Loop:
Set FileItem = Nothing
Set SourceFolder = Nothing
Set FSO = Nothing
Application.DisplayAlerts = True
On Error GoTo 0
End Sub
Rgds
Raymond
