' BigFiles Macro
' This software is provided as-is, without any warranty, either
' express or implied, including the implied warranties of
' merchantability or fitness for a particular purpose. In no event
' will the author be liable to you for any special, consequential,
' indirect, or similar damages. In no case shall the author's liability
' exceed one dollar.
Dim bigfile As Double
Dim base As String
Dim row As Integer
Dim fso
Sub BigFiles()
Dim s As String
' specify how big
s = InputBox( _
"How big is big?" + vbCrLf + _
"Your report will show all big files and all big folders." + vbCrLf + _
"Specify threshhold size in MB", , "10")
If s = "" Then
Exit Sub ' user hit cancel
End If
bigfile = CDbl(s) * 1048576# ' convert from MB to bytes.
' determine beginning path
' if a cell in the name col is selected,
' we're drilling down.
' start with selected folder,
' report on sheet 2
' else
' starting with root.
' ask for drive letter
' report on sheet 1
Sheets(1).Name = "Drive"
Sheets(2).Name = "Drill Down"
If Selection.Column = 10 Then
base = Selection.Value
Worksheets("Drill Down").Activate Else
base = InputBox("Enter Drive Letter", , "C") If base = "" Then
Exit Sub ' user hit cancel
End If
base = base + ":\"
Worksheets("Drive").Activate End If
' Erase entire spreadsheet
Cells.Select
Selection.ClearContents
row = 1
' create a file system object, to access the file system
Set fso = CreateObject("Scripting.FileSystemObject")
' and so it begins
Cells(1, 1).Select
grandtotal = GetFolderSize(base, 0) ' start with base folder, level zero
' Done!
' Label Headers and format columns
Range("A1").Select ActiveCell.FormulaR1C1 = "Created"
Range("B1").Select ActiveCell.FormulaR1C1 = "Modified"
Range("C1").Select ActiveCell.FormulaR1C1 = "Accessed"
Range("D1").Select ActiveCell.FormulaR1C1 = "Base"
Range("E1").Select ActiveCell.FormulaR1C1 = "Sub 1"
Range("F1").Select ActiveCell.FormulaR1C1 = "Sub 2"
Range("G1").Select ActiveCell.FormulaR1C1 = "Sub 3"
Range("H1").Select ActiveCell.FormulaR1C1 = "Deeper"
Range("I1").Select ActiveCell.FormulaR1C1 = "Size"
Range("J1").Select ActiveCell.FormulaR1C1 = "Name"
Columns("A:C").Select Selection.NumberFormat = "m/d/yy"
Columns("D:I").Select Selection.NumberFormat = "#,##0"
Range("A2").Select ActiveWindow.FreezePanes = True
If row > 2 Then
Selection.Sort Key1:=Range("J5"), Order1:=xlAscending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End If
Columns("A:J").EntireColumn.AutoFit
Cells(1, 1).Select ' shift sheet full left
Cells(2, 4).Select ' park in base folder size
MsgBox ("DONE!")End Sub
' *********************************************************8
' Here's where the work gets done
Function GetFolderSize(FolderName, depth)
Dim totalsize As Double, mbsize As Long, sfsize As Double
Dim s As String
Dim lastslash As Integer, col As Integer
Dim folder
' progress
Cells(1, 1) = FolderName
DoEvents
' get a folder object to access this folder
Set folder = fso.GetFolder(FolderName)
' can't do system protected folders, except root, of course
' for example, if you look at "SYSTEM VOLUME INFORMATION",
' you get "access denied"
' This attempts to see the folder, but doesn't die if denied.
If Not folder.IsRootFolder Then
On Error Resume Next ' dont die if next stmt bombs
totalsize = folder.Size ' err occurs if protected
If Err <> 0 Then ' if there was an error...
Err = 0
GetFolderSize = 0
Exit Function
End If
On Error GoTo 0 ' errors kill again.
End If
'add in length of each individual file in this folder.
totalsize = 0
Set filelist = folder.Files ' get a file list
For Each file In filelist
' progress
Cells(1, 1) = file.Path
DoEvents
totalsize = totalsize + file.Size
' ***********************************************************
If file.Size >= bigfile Then
row = row + 1
Cells(row, 1) = file.DateCreated
Cells(row, 2) = file.DateLastModified
Cells(row, 3) = file.DateLastAccessed
Cells(row, 9) = CLng(file.Size / 1048576) ' MB
s = file.Path
lastslash = InStrRev(s, "\")
If lastslash > 3 Then
s = Left(s, lastslash - 1) + " - " + Mid(s, lastslash + 1)
End If
Cells(row, 10) = s
End If
Next
' scan all subfolders. This function calls itself.
' can't use "folder.size", which is denied on "C:\".
' and we have to crawl through each folder anyway, looking
' for big files.
Set sflist = folder.SubFolders ' list of subfolders
For Each sf In sflist ' for each subfolder in the list...
sfsize = GetFolderSize(sf.Path, depth + 1)
totalsize = totalsize + sfsize
Next
' now log this folder (if it's big) to the spreadsheet
If totalsize >= bigfile Then
If depth > 3 Then
col = 8
Else
col = depth + 4
End If
row = row + 1
If folder.IsRootFolder Then
' properties are denied on "c:\"
Cells(row, 1) = ""
Cells(row, 2) = ""
Cells(row, 3) = ""
Else
Cells(row, 1) = folder.DateCreated
Cells(row, 2) = folder.DateLastModified
Cells(row, 3) = folder.DateLastModified
End If
mbsize = CLng(totalsize / 1048576#) ' size in MB
Cells(row, col) = mbsize
Cells(row, 9) = mbsize
Cells(row, 10) = FolderName
End If
' Done with this folder
GetFolderSize = totalsize
End Function
WORKING CODES
ReplyDelete