Option Explicit
Const sPathTop As String = "" 'MAIN PATH GOES HERE WITH \\?\ PREFIX
Const colPath As Long = 1
Const colParent As Long = 2
Const colName As Long = 3
Const colFileFolder As Long = 4
Const colCreated As Long = 5
Const colModified As Long = 6
Const colSize As Long = 7
Const colType As Long = 8
Dim aryExclude As Variant
Dim rowOut As Long
Dim oFSO As Object
Dim wsOut As Worksheet
Dim rPrev As Range
Sub Start()
Dim rowStart As Long
Dim oFile As Object
aryExclude = Array("")
Init
rowStart = rowOut
Call GetFiles(oFSO.GetFolder(sPathTop))
wsOut.Cells(rowStart, colFileFolder).Value = "Parent Folder"
RemoveDups
Cleanup
End Sub
Sub GetFiles(oPath As Object)
Dim oFolder As Object, oSubFolder As Object, oFile As Object
If IsExcluded(oPath) Then Exit Sub ' stops recursion
Call ListInfo(oPath, "Subfolder")
For Each oFile In oPath.Files
Call ListInfo(oFile, "File")
Next
For Each oSubFolder In oPath.SubFolders
Call GetFiles(oSubFolder)
Next
End Sub
'============================================================================
Private Sub Init()
Dim i As Long
Application.ScreenUpdating = False
If IsArray(aryExclude) Then
For i = LBound(aryExclude) To UBound(aryExclude)
aryExclude(i) = CStr(aryExclude(i))
Next i
End If
Set wsOut = Worksheets("Files")
With wsOut
'get last used row, or 1 if empty
rowOut = .Cells(.Rows.Count, 1).End(xlUp).Row
If rowOut = 1 Then ' blank sheet
.Cells(rowOut, colPath).Value = "FILE/FOLDER PATH"
.Cells(rowOut, colParent).Value = "PARENT FOLDER"
.Cells(rowOut, colName).Value = "FILE/FOLDER NAME"
.Cells(rowOut, colFileFolder).Value = "FILE or FOLDER"
.Cells(rowOut, colCreated).Value = "DATE CREATED"
.Cells(rowOut, colModified).Value = "DATE MODIFIED"
.Cells(rowOut, colSize).Value = "SIZE"
.Cells(rowOut, colType).Value = "TYPE"
End If
rowOut = rowOut + 1
'save the previous data
Set rPrev = wsOut.Cells(1, 1).CurrentRegion
End With
Set oFSO = CreateObject("Scripting.FileSystemObject")
End Sub
Private Sub Cleanup()
wsOut.Columns(colName).HorizontalAlignment = xlLeft
wsOut.Columns(colCreated).NumberFormat = "dddd, mmmm d, yyyy h:mm:ss AM/PM"
wsOut.Columns(colModified).NumberFormat = "dddd, mmmm d, yyyy h:mm:ss AM/PM"
wsOut.Columns(colSize).NumberFormat = "#,##0,.0 ""KB"""
wsOut.Cells(1, 2).CurrentRegion.entireColumnn.AutoFit
Application.ScreenUpdating = True
MsgBox "Done"
End Sub
Private Sub RemoveDups()
wsOut.Cells(1, 1).CurrentRegion.RemoveDuplicates Columns:=1, Header:=xlYes
End Sub
' IFolder object
' Attributes, DateCreated, DateLastAccessed, DateLastModified, Drive,
' Files, IsRootFolder, Name, ParentFolder (IFolder), Path,
' ShortName, ShortPath, Size, SubFolders, Type
' iFile object
' Attributes, DateCreated, DateLastAccessed, DateLastModified, Drive (IDrive),
' Name, ParentFolder (IFolder), Path, ShortName, ShortPath, Size, Type
' Attributes
Private Sub ListInfo(oFolderFile As Object, sType As String)
With oFolderFile
wsOut.Cells(rowOut, colPath).Value = RemovePrefix(.Path)
wsOut.Cells(rowOut, colParent).Value = RemovePrefix(oFSO.GetParentFolderName(.Path)) 'oFSO.GetParentFolderName(.Path) or .ParentFolder.Path
wsOut.Cells(rowOut, colName).Value = .Name
wsOut.Cells(rowOut, colFileFolder).Value = sType
wsOut.Cells(rowOut, colCreated).Value = .DateCreated
wsOut.Cells(rowOut, colModified).Value = .DateLastModified
wsOut.Cells(rowOut, colSize).Value = .size
wsOut.Cells(rowOut, colType).Value = .Type
End With
rowOut = rowOut + 1
End Sub
Private Function IsExcluded(p As Object) As Boolean
Dim i As Long
If IsEmpty(aryExclude) Then
IsExcluded = False
Exit Function
End If
IsExcluded = True
For i = LBound(aryExclude) To UBound(aryExclude)
If UCase(p.Path) = UCase(aryExclude(i)) Then Exit Function ' <<<<<<<
Next i
IsExcluded = False
End Function
Private Function RemovePrefix(s As String) As String
If Len(s) < 5 Then
RemovePrefix = s
Else
RemovePrefix = IIf(Left(s, 4) = "\\?\", Right(s, Len(s) - 4), s)
End If
End Function