FIND BIG FILES BY EXCEL FILE

 

' 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