vbscript to report folder+subfolder size inc different file type repor 1

winwell1888 · Nov 10, 2010

Hello

I am involved in reducing e-waste for my company (wastage in terms of duplicate data, bad file structure, bad folder names, folder depths etc and the human waste in lost time trying find stuff etc).

So we would like to run a script on our root directories (we have loads of them) so establish the following information and present it in excel:

The folder structure and the size of each folder
The number of different file types and the size of each file type.

E.G. Directory A has 3 folders and each of them has multiple subfolders containg a mix of .doc, .xls and .ppt files.

The script would produce a report in excel something like this:

Directory A
10MB Folder1
30MB Folder2
50MB Folder3
7MB Folder1/sub1
3MB Folder1/sub1/sub2

and so on.

Then the file types
Folder 1
12 doc files 3MB
24 ppt file 4MB
35 xls files 3MB

and so on or somthing like that anyway.

At the end of the day, we would like to be able to understand what each directory looks like and suggest ways to improve the structure. So if we could show files stored 7, 8 9 folders deep for example, we could highlight that. We could also show the number & size of different file types. We would use windows explorer to look for duplicate files and/or large files and suggest ways to reduce them or delete if needbe. Then we could re run the script to monitor progress an dmaybe even calculate the savings in $ terms (assuming we can assign a value to a MB of server space)

I hope that makes sense?

We already have a script to produce the first part of the task (get folder size and structure and dump into excel) and I list that below. I don't know where that came from but it was found online somewhere and tweaked a bit).

it would be ideal if the file type part couldbe added into what we've already got if possible.

Run this for any folder and you'll see how it works

Any suggestions or ideas welcomed,

many thanks

Code:

Sub CheckFolder(objCurrentFolder)

        on error resume next

       For Each objFolder In objCurrentFolder.SubFolders

         FolderSize = objFolder.Size

         Tmp = (FormatNumber(FolderSize, 0, , , 0)/1024)/1024

         ObjXL.ActiveSheet.Cells(icount,2).Value = objFolder.Path

         ObjXL.ActiveSheet.Cells(icount,1).Value = Tmp

         icount = icount + 1

       Next

       'Recurse through all of the folders

       For Each objNewFolder In objCurrentFolder.subFolders

               CheckFolder objNewFolder

       Next

       

End Sub

rootfolder = Inputbox("Enter DIR or folder path: "& chr(10) & "(Include trailing backslash at end of path)" & _
chr(10) & chr(10) & "(e.g.\\Server\DIR Name\Folder\etc\)" & chr(10) & chr(10), _
"Getfoldersize", "C:\temp\")



'Run checkfolder if something was entered in the CAF directory field, else just end

if rootfolder <> "" Then 



   outputfile = "C:\temp\foldersize_" & Day(now) & Month(now) & Year(now) & ".xls"

   Set fso = CreateObject("scripting.filesystemobject")

   if fso.fileexists(outputfile) then fso.deletefile(outputfile)

'Create Excel workbook

   set objXL = CreateObject( "Excel.Application" )

   objXL.Visible = False

   objXL.WorkBooks.Add

'Counter 1 for writing in cell A1 within the excel workbook

   icount = 1

'Run checkfolder

   CheckFolder (FSO.getfolder(rootfolder))





'Lay out for Excel workbook 

   objXL.Range("A1").Select

   objXL.Selection.EntireRow.Insert

   objXL.Selection.EntireRow.Insert

   objXL.Selection.EntireRow.Insert

   objXL.Selection.EntireRow.Insert

   objXL.Selection.EntireRow.Insert

   objXL.Selection.EntireRow.Insert

   objXL.Selection.EntireRow.Insert

   objXL.Selection.EntireRow.Insert

   objXL.Selection.EntireRow.Insert

        objXL.Columns(1).ColumnWidth = 21

        objXL.Columns(2).ColumnWidth = 21

   objXL.Columns(1).NumberFormat = "#,##0.0"

   objXL.Range("A1").NumberFormat = "d-m-yyyy"

   objXL.Range("A1:B9").Select

   objXL.Selection.Font.Bold = True

   objXL.Range("A1:B5").Select

   objXL.Selection.Font.ColorIndex = 5

   objXL.Range("B2").Select

   objXL.Selection.Font.Italic = True

   objXL.Selection.Font.Size = 16

   ObjXL.ActiveSheet.Cells(1,2).Value = "DIR FolderSize and Folder Structure" 

   ObjXL.ActiveSheet.Cells(1,1).Value = Day(now) & "-" & Month(now) & "-"& Year(now)

   ObjXL.ActiveSheet.Cells(2,1).Value = UCase(rootfolder)

   ObjXL.ActiveSheet.Cells(3,1).Value = "Folders are separated by --> so they can be seen more easily"

   objXL.ActiveSheet.Cells(5,1).Value = "Total DIR Size (MB)"

   objXL.Range("B5").Select

   objXL.Selection.HorizontalAlignment = -4108

   objXL.Selection.Font.ColorIndex = 3

   objXL.Range("B6").Select

   objXL.Selection.HorizontalAlignment = -4108

   objXL.Selection.Font.ColorIndex = 3

   objXL.Selection.NumberFormat = "£#,##0.0"

   objXL.Range("A9:B9").Select

   objXL.Selection.Font.Bold = True

   ObjXL.ActiveSheet.Cells(9,1).Value = "Total (MB)"

   ObjXL.ActiveSheet.Cells(9,2).Value = "Folder"   

   objXL.Range("B:B").Replace rootfolder, ""' get rid of the \\IRF etc bit 

   objXL.Range("B:B").Replace "\", "-->" ' make it a bit easier to spot the folders

'Finally close the workbook

   ObjXL.ActiveWorkbook.SaveAs(outputfile)

   ObjXL.Application.Quit

   Set ObjXL = Nothing

'Message when finished

   Set WshShell = CreateObject("WScript.Shell")

   Finished = Msgbox ("Script executed successfully, results can be found in " & Chr(10) _
                     & outputfile & "." & Chr(10) & Chr(10) _
                     & "Do you want to view the results now?", 65, "Script executed successfully!")

   if Finished = 1 then WshShell.Run "excel " & outputfile



end if

jges · Nov 10, 2010

Here's something to get you started:

Code:

Sub CheckFolder(objCurrentFolder)
	Dim dicFileTypes
	Set dicFileTypes = CreateObject("Scripting.Dictionary")
	on error resume next
	
	For Each objFolder In objCurrentFolder.SubFolders
		FolderSize = objFolder.Size
		Tmp = (FormatNumber(FolderSize, 0, , , 0)/1024)/1024
		ObjXL.ActiveSheet.Cells(icount,2).Value = objFolder.Path
		ObjXL.ActiveSheet.Cells(icount,1).Value = Tmp
		for each objFile in objCurrentFolder.Files
			'check the extension: if we have seen it before, add file size to current total
			f_ext = LCase(fso.GetExtensionName(objFile))
			if f_ext = "" then
				f_ext = "<none>"
			end if
			if dicFileTypes.Exists(f_ext) then
				dicFileTypes.Item(f_ext) = dicFileTypes.Item(f_ext) + objFile.Size
			else
				'new file type: add it
				dicFileTypes.Add f_ext, objFile.Size
			end if
		next
		col = 3
		for each objFileType in dicFileTypes
			ObjXL.ActiveSheet.Cells(icount,col).Value = objFileType
			ObjXL.ActiveSheet.Cells(icount,col + 1).Value = dicFileTypes.Item(objFileType)
			col = col + 2
		next
		icount = icount + 1
		'Recurse through all of the folders
		CheckFolder objFolder
	Next
	
End Sub

rootfolder = Inputbox("Enter DIR or folder path: "& chr(10) & "(Include trailing backslash at end of path)" & _
	chr(10) & chr(10) & "(e.g.\\Server\DIR Name\Folder\etc\)" & chr(10) & chr(10), _
	"Getfoldersize", "C:\temp\")

'Run checkfolder if something was entered in the CAF directory field, else just end

if rootfolder <> "" Then
	outputfile = "C:\temp\foldersize_" & Day(now) & Month(now) & Year(now) & ".xls"
	Set fso = CreateObject("scripting.filesystemobject")
	if fso.fileexists(outputfile) then fso.deletefile(outputfile)
	'Create Excel workbook
	set objXL = CreateObject( "Excel.Application" )
	objXL.Visible = False
	objXL.WorkBooks.Add
	
	'Counter 1 for writing in cell A1 within the excel workbook
	icount = 10

	'Run checkfolder
	CheckFolder (FSO.getfolder(rootfolder))

	'Lay out for Excel workbook
	With objXL
		.Range("A1").Select
		.Columns(1).ColumnWidth = 21
		.Columns(2).ColumnWidth = 21
		.Columns(1).NumberFormat = "#,##0.0"
		.Range("A1").NumberFormat = "d-m-yyyy"
		.Range("A1:B9").Select
		.Selection.Font.Bold = True
		.Range("A1:B5").Select
		.Selection.Font.ColorIndex = 5
		.Range("B2").Select
		.Selection.Font.Italic = True
		.Selection.Font.Size = 16
		.ActiveSheet.Cells(1,2).Value = "DIR FolderSize and Folder Structure"
		.ActiveSheet.Cells(1,1).Value = Day(now) & "-" & Month(now) & "-"& Year(now)
		.ActiveSheet.Cells(2,1).Value = UCase(rootfolder)
		.ActiveSheet.Cells(3,1).Value = "Folders are separated by --> so they can be seen more easily"
		.ActiveSheet.Cells(5,1).Value = "Total DIR Size (MB)"
		.Range("B5").Select
		.Selection.HorizontalAlignment = -4108
		.Selection.Font.ColorIndex = 3
		.Range("B6").Select
		.Selection.HorizontalAlignment = -4108
		.Selection.Font.ColorIndex = 3
		.Selection.NumberFormat = "£#,##0.0"
		.Range("A9:B9").Select
		.Selection.Font.Bold = True
		.ActiveSheet.Cells(9,1).Value = "Total (MB)"
		.ActiveSheet.Cells(9,2).Value = "Folder"   
		.Range("B:B").Replace rootfolder, ""' get rid of the \\IRF etc bit
		.Range("B:B").Replace "\", "-->" ' make it a bit easier to spot the folders
		
		'Finally close the workbook
		.ActiveWorkbook.SaveAs(outputfile)
		.Application.Quit
	End With
	Set ObjXL = Nothing
	
	'Message when finished
	Set WshShell = CreateObject("WScript.Shell")
	Finished = Msgbox ("Script executed successfully, results can be found in " & Chr(10) _
                     & outputfile & "." & Chr(10) & Chr(10) _
                     & "Do you want to view the results now?", 65, "Script executed successfully!")
	
	if Finished = 1 then WshShell.Run "excel " & outputfile
	
end if

I changed the folder recursion a little bit to group the subfolders under their container folder. Also, it adds the file types and the total size of those files (currently in bytes) in the columns to the right of the folder they are found in.

winwell1888 · Nov 10, 2010

Thanks, that is excellent.

Could it also report the number of files in each folder as well as the size?

e.g. doc 7550976 35 files
xls 8916992 26 files
ppt 39596033 38 files

or something similar?

winwell1888 · Nov 10, 2010

Another quick questions re file types:

The script finds the following file types:
doc, xls, ppt, txt and mht.

There are adobe pdf files in my folders along with html, but they don't show up. Does the script not recognize them and therefore report them as mht?

We have no files with mht in our folders hence the theory that the script assigns mht to file types it doesn't recognize?

Thanks

winwell1888 · Nov 10, 2010

Actually, its doing the same with txt. We don't have any txt files and its reporting txt as being present.

jges · Nov 11, 2010

Whoops
change the line:

Code:

 for each objFile in obj[COLOR=red]Current[/color]Folder.Files

to

Code:

 for each objFile in objFolder.Files

That should take care of the bug.

jges · Nov 11, 2010

This version reports the file extension, # files of that type, and the combined size of those files.

Code:

Sub CheckFolder(objCurrentFolder)
	Dim dicFileTypes
	Set dicFileTypes = CreateObject("Scripting.Dictionary")
	on error resume next
	dim fileCountSize(1)
	
	For Each objFolder In objCurrentFolder.SubFolders
		FolderSize = objFolder.Size
		Tmp = (FormatNumber(FolderSize, 0, , , 0)/1024)/1024
		ObjXL.ActiveSheet.Cells(icount,2).Value = objFolder.Path
		ObjXL.ActiveSheet.Cells(icount,1).Value = Tmp
		for each objFile in objFolder.Files
			'check the extension: if we have seen it before, add file size to current total
			f_ext = LCase(fso.GetExtensionName(objFile))
			if f_ext = "" then
				f_ext = "<none>"
			end if
			if dicFileTypes.Exists(f_ext) then
				fileCountSize = dicFileTypes.Item(f_ext)
				fileCountSize(0) = fileCountSize(0) + 1
				fileCountSize(1) = fileCountSize(1) + objFile.Size
				dicFileTypes.Item(f_ext) = fileCountSize
			else
				'new file type: add it
				fileCountSize(0) = 1
				fileCountSize(1) = objFile.Size
				dicFileTypes.Add f_ext, fileCountSize
			end if
		next
		col = 3
		for each objFileType in dicFileTypes
			ObjXL.ActiveSheet.Cells(icount,col).Value = objFileType
			fileCountSize = dicFileTypes.Item(objFileType)
			ObjXL.ActiveSheet.Cells(icount,col + 1).Value = fileCountSize(0)
			ObjXL.ActiveSheet.Cells(icount,col + 2).Value = fileCountSize(1)
			col = col + 3
		next
		dicFileTypes.RemoveAll
		icount = icount + 1
		'Recurse through all of the folders
		CheckFiles objFolder
		CheckFolder objFolder
	Next
	
End Sub


rootfolder = Inputbox("Enter DIR or folder path: "& chr(10) & "(Include trailing backslash at end of path)" & _
	chr(10) & chr(10) & "(e.g.\\Server\DIR Name\Folder\etc\)" & chr(10) & chr(10), _
	"Getfoldersize", "C:\temp\")

'Run checkfolder if something was entered in the CAF directory field, else just end

if rootfolder <> "" Then
	outputfile = "C:\temp\foldersize_" & Day(now) & Month(now) & Year(now) & ".xls"
	Set fso = CreateObject("scripting.filesystemobject")
	if fso.fileexists(outputfile) then fso.deletefile(outputfile)
	'Create Excel workbook
	set objXL = CreateObject( "Excel.Application" )
	objXL.Visible = False
	objXL.WorkBooks.Add
	
	'Counter 1 for writing in cell A1 within the excel workbook
	icount = 10

	'Run checkfolder
	CheckFolder (FSO.getfolder(rootfolder))

	'Lay out for Excel workbook
	With objXL
		.Range("A1").Select
		.Columns(1).ColumnWidth = 21
		.Columns(2).ColumnWidth = 21
		.Columns(1).NumberFormat = "#,##0.0"
		.Range("A1").NumberFormat = "d-m-yyyy"
		.Range("A1:B9").Select
		.Selection.Font.Bold = True
		.Range("A1:B5").Select
		.Selection.Font.ColorIndex = 5
		.Range("B2").Select
		.Selection.Font.Italic = True
		.Selection.Font.Size = 16
		.ActiveSheet.Cells(1,2).Value = "DIR FolderSize and Folder Structure"
		.ActiveSheet.Cells(1,1).Value = Day(now) & "-" & Month(now) & "-"& Year(now)
		.ActiveSheet.Cells(2,1).Value = UCase(rootfolder)
		.ActiveSheet.Cells(3,1).Value = "Folders are separated by --> so they can be seen more easily"
		.ActiveSheet.Cells(5,1).Value = "Total DIR Size (MB)"
		.Range("B5").Select
		.Selection.HorizontalAlignment = -4108
		.Selection.Font.ColorIndex = 3
		.Range("B6").Select
		.Selection.HorizontalAlignment = -4108
		.Selection.Font.ColorIndex = 3
		.Selection.NumberFormat = "£#,##0.0"
		.Range("A9:B9").Select
		.Selection.Font.Bold = True
		.ActiveSheet.Cells(9,1).Value = "Total (MB)"
		.ActiveSheet.Cells(9,2).Value = "Folder"   
		.Range("B:B").Replace rootfolder, ""' get rid of the \\IRF etc bit
		.Range("B:B").Replace "\", "-->" ' make it a bit easier to spot the folders
		
		'Finally close the workbook
		.ActiveWorkbook.SaveAs(outputfile)
		.Application.Quit
	End With
	Set ObjXL = Nothing
	
	'Message when finished
	Set WshShell = CreateObject("WScript.Shell")
	Finished = Msgbox ("Script executed successfully, results can be found in " & Chr(10) _
                     & outputfile & "." & Chr(10) & Chr(10) _
                     & "Do you want to view the results now?", 65, "Script executed successfully!")
	
	if Finished = 1 then WshShell.Run "excel " & outputfile
	
end if

Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

vbscript to report folder+subfolder size inc different file type repor 1

winwell1888

IS-IT--Management

jges

Technical User

winwell1888

IS-IT--Management

winwell1888

IS-IT--Management

winwell1888

IS-IT--Management

jges

Technical User

jges

Technical User

Similar threads

Part and Inventory Search

Sponsor