Option Explicit
Sub PopulateDirectoryList()
Dim objFSO As FileSystemObject, objFolder As Folder
Dim objFile As File, strSourceFolder As String, x As Long, i As Long
Dim wbNew As Workbook, wsNew As Worksheet
ToggleStuff False
Set objFSO = New FileSystemObject
strSourceFolder = BrowseForFolder
If strSourceFolder = "" Then Exit Sub
Workbooks.Add
Set wbNew = ActiveWorkbook
Set wsNew = wbNew.Sheets(1)
wsNew.Activate
With wsNew.Range("A1:F1")
.Value = Array("File", "Size", "Modified Date", "Last Accessed", "Created Date", "Full Path", "Size")
.Interior.ColorIndex = 7
.Font.Bold = True
.Font.Size = 12
End With
With Application.FileSearch
.LookIn = strSourceFolder
.FileType = msoFileTypeAllFiles
.SearchSubFolders = True
.Execute
For x = 1 To .FoundFiles.Count
i = x
If x > 60000 Then
i = x - 60000
Set wsNew = wbNew.Sheets.Add(after:=Sheets(wsNew.Index))
With wsNew.Range("A1:F1")
.Value = Array("File", "Parent Folder", "Full Path", "Modified Date", _
"Last Accessed", "Size")
.Interior.ColorIndex = 7
.Font.Bold = True
.Font.Size = 12
End With
End If
On Error GoTo Skip
Set objFile = objFSO.GetFile(.FoundFiles(x))
With wsNew.Cells(1, 1)
.Offset(i, 0) = objFile.Name
.Offset(i, 1) = Format(objFile.Size, "0,000") & " KB"
.Offset(i, 2) = objFile.DateLastModified
.Offset(i, 3) = objFile.DateLastAccessed
.Offset(i, 4) = objFile.DateCreated
.Offset(i, 5) = objFile.Path
End With
Skip:
Next x
wsNew.Columns("A:F").AutoFit
End With
Set objFolder = Nothing
Set objFile = Nothing
Set objFSO = Nothing
Set wsNew = Nothing
Set wbNew = Nothing
ToggleStuff True
End Sub
Sub ToggleStuff(ByVal x As Boolean)
Application.ScreenUpdating = x
Application.EnableEvents = x
End Sub
Function BrowseForFolder(Optional OpenAt As Variant) As Variant
Dim ShellApp As Object
Set ShellApp = CreateObject("Shell.Application"). _
BrowseForFolder(0, "Please choose a folder", 0, OpenAt)
On Error Resume Next
BrowseForFolder = ShellApp.self.Path
On Error GoTo 0
Set ShellApp = Nothing
Select Case Mid(BrowseForFolder, 2, 1)
Case Is = ":"
If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
Case Is = "\"
If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
Case Else
GoTo Invalid
End Select
Exit Function
Invalid:
ToggleStuff True
End Function
|