Header Ads

test

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
 
 
 
 
 

1 comment:

please write your mail id for contact: