Submitted By: Andy Valko

Generates a tab-delimited report on the file age, file extension and directory depth of a directory and its child members. The file age is based on the last modified date and the maximum depth value is set to 8. Command-line options include: /dir = directory to report on; /depth = output file that contains the list of folders that exceed the folder depth limit; /err = output file that contains the list of folders and files that generated an error condition; /list = output file that contains the list of ALL files . The List option should be used judiciously; /rep =output file that contains the directory report.

Visual Basic
Edit|Remove
Dim fso, fout1, fout2, fout3, fin1, FolderName, FileTypeOutput, ReportOutput, NameSize, RetVal
Dim PCFiles, PCSpace, I, UBoundCtrArray, UBoundOptArray, ListName, RepName, ErrName
Dim DepthName, ReportDescription, BlankFiller, ReportType

Const Ireport = 0
Const Ierror = 1
Const Ilist = 2
Const Idepthopt = 3

Const ITotal = 0
Const I30 = 1
Const I60 = 2
Const I90 = 3
Const I180 = 4
Const I365 = 5
Const I999 = 6
Const Ibmp = 7
Const Idoc = 8
Const Iexe = 9
Const Igif = 10
Const Ijpg = 11
Const Imdb = 12
Const Imp3 = 13
Const Impg = 14
Const Ipdf = 15
Const Ippt = 16
Const Ipst = 17
Const Iwav = 18
Const Iwmv = 19
Const Ixls = 20
Const Izip = 21
Const Idepth = 22

Const MaxFolderDepth = 8

Redim CtrArray(23,2)
Redim OptArray(4)


UBoundCtrArray = Ubound(CtrArray,1)
For I = 0 to UBoundCtrArray -1
	CtrArray(I,1) = 0
	CtrArray(I,2) = 0
Next

UBoundOptArray = Ubound(OptArray,1)
For I = 0 to UBoundOptArray -1
	OptArray(I) = False
Next

FolderName = ""
ListName = ""
RepName = ""
ErrName = ""
DepthName = ""

set x = wscript.arguments
if x.count > 0 then
	for i = 0 to x.count -1
		If lcase(Left(x(i),6)) = "/list=" then
			OptArray(Ilist) = True
			NameSize = Len(x(i)) - 6
			ListName = Right(x(i), NameSize)
		ElseIf lcase(Left(x(i),5)) = "/dir=" then
			NameSize = Len(x(i)) - 5
			FolderName = Right(x(i), NameSize)
		ElseIf lcase(Left(x(i),5)) = "/err=" then
			OptArray(Ierror) = True
			NameSize = Len(x(i)) - 5
			ErrName = Right(x(i), NameSize)			
		ElseIf lcase(Left(x(i),5)) = "/rep=" then
			OptArray(Ireport) = True
			NameSize = Len(x(i)) - 5
			RepName = Right(x(i), NameSize)
		ElseIf lcase(Left(x(i),7)) = "/depth=" then
			OptArray(Idepthopt) = True
			NameSize = Len(x(i)) - 7
			DepthName = Right(x(i), NameSize)
		ElseIf lcase(x(i)) = "/?" then
			MsgMsg = "The Directory Report generates a tab delimited report on the file age, file extension and directorypth de" & _
    " of the directory and its child members" & vbcrlf
			MsgMsg = " The Directory Report options are " & vbcrlf
			MsgMsg = MsgMsg & "/dir=  - directory to report on" & vbcrlf
			MsgMsg = MsgMsg & "/depth= - output file that lists the folders that exceed the folder depth limit " & vbcrlf
			MsgMsg = MsgMsg & "/err= - output file that lists the folders & files that generated an error" & vbcrlf
			MsgMsg = MsgMsg & "/list= - output file that lists all the files " & vbcrlf
			MsgMsg = MsgMsg & "/rep= -  output file that contains directory report " & vbcrlf
			msgbox  MsgMsg
			Wscript.Quit
		End If
	next
End if

If FolderName = "" Then
	If OptArray(Ireport) = True Then
		Wscript.Quit
	Else
		TmpName = InputBox("Enter the directory name") 
		If TmpName = "" Then
			Wscript.Quit
		Else
			RetVal = MsgBox ("You entered: " & TmpName, 65, "Directory Report")
			If RetVal <> 1 then
				Wscript.Quit
			Else
				FolderName = Trim(TmpName)
			End If
		End If
	End If
End If


If OptArray(Ireport) = False Then
	If OptArray(Ilist) = False Then
		RetVal = msgbox  ("Do you want to perform a Directory Report", 65, "Directory Report")
		if RetVal <> 1 then
			Wscript.Quit
		End If
	Else
		RetVal = msgbox  ("Do you want to LIST the Directory Report files", 65, "Directory Report")
		if RetVal <> 1 then
			Wscript.Quit
		End If
	End If
Else
	If RepName = "" Then
		Wscript.Quit
	End If
End If 

On Error Resume Next

Set fso = CreateObject("Scripting.FileSystemObject")


If OptArray(Ireport) = True Then
	Set fout1 = fso.OpenTextFile(RepName, 2, True)
End If

If OptArray(Ilist) = True Then
	Set fout2 = fso.OpenTextFile(ListName, 2, True)
End If

If OptArray(Ierror) = True Then
	Set fout3 = fso.OpenTextFile(ErrName, 2, True)
End If

If OptArray(Idepthopt) = True Then
	Set fout4 = fso.OpenTextFile(DepthName, 2, True)
End If


Sub ListFolders(fso, folderspec, ByRef CtrArray, ByRef OptArray)
	Dim  f, Ffolder, NumFolders, NewFolder

	On Error Resume Next
	Call ListFiles (fso, folderspec, CtrArray, OptArray)
	Set f = fso.GetFolder(folderspec)
	If (Err.Number <> 0) Then
		If  OptArray(Ierror) = True Then
			Fout3.writeline ("Folder Error " & folderspec & " " & HEX(Err.Number))
		End If
		Err.Clear
		Exit Sub
	End If
	CtrArray(Idepth,1) = CtrArray(Idepth,1) + 1
	If OptArray(Idepthopt) = True Then
		If  CtrArray(Idepth,1) > MaxFolderDepth Then
			Fout4.writeline (CtrArray(Idepth,1) & "  " & folderspec )
		End If
	End If
	If CtrArray(Idepth,1) > CtrArray(Idepth,2) Then
		CtrArray(Idepth,2) = CtrArray(Idepth,1)
	End If
	Set NumFolders = f.SubFolders
	For Each Ffolder in NumFolders
		NewFolder = folderspec & "\" & Ffolder.name
		Call ListFolders(fso, NewFolder, CtrArray, OptArray)
	Next
	CtrArray(Idepth,1) = CtrArray(Idepth,1) - 1
End Sub

Sub ListFiles(fso, folderspec, ByRef CtrArray, ByRef OptArray)
	Dim f, ff, Ffile, NumFiles, Ffilename, DiffADate,  ListFileName, FirstErrNumber, FileSize

	On Error Resume Next
	Set f = fso.GetFolder(folderspec)
	If (Err.Number <> 0) Then
		If OptArray(Ierror) = True Then
			Fout3.writeline ("Folder Error " & folderspec & " " & HEX(Err.Number))
		End If
		Err.Clear
		Exit Sub
	End If

	Set NumFiles = f.Files
	For Each Ffile in NumFiles
'		DiffADate = Abs(DateDiff("d", Now, Ffile.datecreated))
		DiffADate = Abs(DateDiff("d", Now, Ffile.datelastmodified))
		FileSize = CDbl(Ffile.size)
		FfileName = Ffile.name
		If OptArray(Ilist) = True Then
			fout2.writeline(Folderspec & vbtab & FfileName & vbtab & DiffADate & vbtab & Ffile.datelastmodified & vbtab & FileSize)
		End If
		CtrArray(ITotal,1) = CtrArray(ITotal,1) + 1
		CtrArray(ITotal,2) = CtrArray(ITotal,2)  + FileSize
		If DiffADate <=30 Then
			CtrArray(I30,1) = CtrArray(I30,1) + 1
			CtrArray(I30,2) = CtrArray(I30,2)  + FileSize
		ElseIf DiffADate >30 and DiffADate <= 60 Then
			CtrArray(I60,1) = CtrArray(I60,1) + 1
			CtrArray(I60,2) = CtrArray(I60,2)  + FileSize
		ElseIf DiffADate >60 and DiffADate <= 90 Then
			CtrArray(I90,1) = CtrArray(I90,1) + 1
			CtrArray(I90,2) = CtrArray(I90,2)  + FileSize
		ElseIf DiffADate >90 and DiffADate <= 180 Then
			CtrArray(I180,1) = CtrArray(I180,1) + 1
			CtrArray(I180,2) = CtrArray(I180,2)  + FileSize
		ElseIf DiffADate >180 and DiffADate <= 365 Then
			CtrArray(I365,1) = CtrArray(I365,1) + 1
			CtrArray(I365,2) = CtrArray(I365,2)  + FileSize
		Else
			CtrArray(I999,1) = CtrArray(I999,1) + 1
			CtrArray(I999,2) = CtrArray(I999,2)  + FileSize
		End If

			
		If Len(FfileName) > 4 Then
			FfileExt = Trim(Lcase(Right(FfileName, 4)))	
			Select Case FfileExt
			Case ".bmp"
				CtrArray(Ibmp,1) = CtrArray(Ibmp,1) + 1
				CtrArray(Ibmp,2) = CtrArray(Ibmp,2)  + FileSize
			Case ".doc"
				CtrArray(Idoc,1) = CtrArray(Idoc,1) + 1
				CtrArray(Idoc,2) = CtrArray(Idoc,2)  + FileSize
			Case ".exe"
				CtrArray(Iexe,1) = CtrArray(Iexe,1) + 1
				CtrArray(Iexe,2) = CtrArray(Iexe,2)  + FileSize
			Case ".gif"
				CtrArray(Igif,1) = CtrArray(Igif,1) + 1
				CtrArray(Igif,2) = CtrArray(Igif,2)  + FileSize
			Case ".jpg", "jpeg", ".jpe"
				CtrArray(Ijpg,1) = CtrArray(Ijpg,1) + 1
				CtrArray(Ijpg,2) = CtrArray(Ijpg,2)  + FileSize
			Case ".mdb"
				CtrArray(Imdb,1) = CtrArray(Imdb,1) + 1
				CtrArray(Imdb,2) = CtrArray(Imdb,2)  + FileSize
			Case ".mp3", ".m4a", ".m4b", ".m4p"
				CtrArray(Imp3,1) = CtrArray(Imp3,1) + 1
				CtrArray(Imp3,2) = CtrArray(Imp3,2)  + FileSize
			Case ".mpg", ".mp4", ".mpe", ".m4v"
				CtrArray(Impg,1) = CtrArray(Impg,1) + 1
				CtrArray(Impg,2) = CtrArray(Impg,2)  + FileSize
			Case ".pdf"
				CtrArray(Ipdf,1) = CtrArray(Ipdf,1) + 1
				CtrArray(Ipdf,2) = CtrArray(Ipdf,2)  + FileSize
			Case ".ppt"
				CtrArray(Ippt,1) = CtrArray(Ippt,1) + 1
				CtrArray(Ippt,2) = CtrArray(Ippt,2)  + FileSize
			Case ".pst"
				CtrArray(Ipst,1) = CtrArray(Ipst,1) + 1
				CtrArray(Ipst,2) = CtrArray(Ipst,2)  + FileSize
			Case ".wav"
				CtrArray(Iwav,1) = CtrArray(Iwav,1) + 1
				CtrArray(Iwav,2) = CtrArray(Iwav,2)  + FileSize
			Case ".wmv"
				CtrArray(Iwmv,1) = CtrArray(Iwmv,1) + 1
				CtrArray(Iwmv,2) = CtrArray(Iwmv,2)  + FileSize
			Case ".xls"
				CtrArray(Ixls,1) = CtrArray(Ixls,1) + 1
				CtrArray(Ixls,2) = CtrArray(Ixls,2)  + FileSize
			Case ".zip", ".tar", ".rar"
				CtrArray(Izip,1) = CtrArray(Izip,1) + 1
				CtrArray(Izip,2) = CtrArray(Izip,2)  + FileSize
			End Select
		End If

	Next

End Sub


CtrArray(Idepth, 1) = -1
Call ListFolders(fso, FolderName, CtrArray, OptArray )

ReportOutput = FolderName & "  Directory Report  " & Now & "  Max Depth " & CtrArray(IDepth,2) & vbcrlf & vbcrlf

ReportDescription = "Date Last Modified"
ReportOutput = ReportOutput & ReportDescription & vbtab & "#Files" & vbtab & "%Files" & vbtab & "Space" & _
    vbtab & "%Space" & vbcrlf
PCFiles = FormatPercent(CtrArray(I30,1)/CtrArray(ITotal,1))
PCSpace = FormatPercent(CtrArray(I30,2)/CtrArray(ITotal,2))
ReportType = "0-30 days"
BlankFiller = String(Len(ReportDescription) - Len(ReportType), " ")
ReportOutput = ReportOutput & ReportType & BlankFiller & vbtab & CtrArray(I30,1) & vbtab & PCFiles & vbtab & _
    CtrArray(I30,2) & vbtab &  PCSpace & vbcrlf
PCFiles = FormatPercent(CtrArray(I60,1)/CtrArray(ITotal,1))
PCSpace = FormatPercent(CtrArray(I60,2)/CtrArray(ITotal,2))
ReportType = "31-60 days"
BlankFiller = String(Len(ReportDescription) - Len(ReportType), " ")
ReportOutput = ReportOutput & ReportType & BlankFiller & vbtab & CtrArray(I60,1)& vbtab & PCFiles & vbtab & _
    CtrArray(I60,2) & vbtab &  PCSpace &  vbcrlf
PCFiles = FormatPercent(CtrArray(I90,1)/CtrArray(ITotal,1))
PCSpace = FormatPercent(CtrArray(I90,2)/CtrArray(ITotal,2))
ReportType = "61-90 days"
BlankFiller = String(Len(ReportDescription) - Len(ReportType), " ")
ReportOutput = ReportOutput & ReportType & BlankFiller & vbtab & CtrArray(I90,1) & vbtab & PCFiles & vbtab & _
    CtrArray(I90,2) & vbtab & PCSpace &  vbcrlf
PCFiles = FormatPercent(CtrArray(I180,1)/CtrArray(ITotal,1))
PCSpace = FormatPercent(CtrArray(I180,2)/CtrArray(ITotal,2))
ReportType = "91-180 days"
BlankFiller = String(Len(ReportDescription) - Len(ReportType), " ")
ReportOutput = ReportOutput & ReportType & BlankFiller & vbtab & CtrArray(I180,1) & vbtab & PCFiles & vbtab & _
     CtrArray(I180,2) & vbtab &  PCSpace &  vbcrlf
PCFiles = FormatPercent(CtrArray(I365,1)/CtrArray(ITotal,1))
PCSpace = FormatPercent(CtrArray(I365,2)/CtrArray(ITotal,2))
ReportType = "180-365 days"
BlankFiller = String(Len(ReportDescription) - Len(ReportType), " ")
ReportOutput = ReportOutput & ReportType & BlankFiller & vbtab & CtrArray(I365,1) & vbtab & PCFiles & vbtab & _
    CtrArray(I365,2) & vbtab &  PCSpace &  vbcrlf
PCFiles = FormatPercent(CtrArray(I999,1)/CtrArray(ITotal,1))
PCSpace = FormatPercent(CtrArray(I999,2)/CtrArray(ITotal,2))
ReportType = "365+ days"
BlankFiller = String(Len(ReportDescription) - Len(ReportType), " ")
ReportOutput = ReportOutput & ReportType & BlankFiller & vbtab & CtrArray(I999,1) & vbtab & PCFiles & vbtab & _
    CtrArray(I999,2) & vbtab & PCSpace &  vbcrlf 
ReportType = "TOTAL FILES"
BlankFiller = String(Len(ReportDescription) - Len(ReportType), " ")
ReportOutput = ReportOutput & ReportType & BlankFiller & vbtab & CtrArray(ITotal,1) & vbtab & vbtab & _
    CtrArray(ITotal,2) & vbtab & vbcrlf

ReportDescription = "File Extension Report"
FileTypeOutput = vbcrlf & ReportDescription & vbtab & "#Files" & vbtab & "Space" & vbcrlf
BlankFiller = String(Len(ReportDescription) - 3, " ")
FileTypeOutput = FileTypeOutput & "Bmp " & BlankFiller & vbtab & CtrArray(Ibmp,1) & vbtab & CtrArray(Ibmp,2) & vbcrlf
FileTypeOutput = FileTypeOutput & "Doc " & BlankFiller & vbtab & CtrArray(Idoc,1) & vbtab & CtrArray(Idoc,2) & vbcrlf
FileTypeOutput = FileTypeOutput & "Exe " & BlankFiller & vbtab & CtrArray(Iexe,1) & vbtab & CtrArray(Iexe,2) & vbcrlf
FileTypeOutput = FileTypeOutput & "Gif " & BlankFiller & vbtab & CtrArray(Igif,1) & vbtab & CtrArray(Igif,2) & vbcrlf
FileTypeOutput = FileTypeOutput & "Jpg " & BlankFiller & vbtab & CtrArray(Ijpg,1) & vbtab & CtrArray(Ijpg,2) & vbcrlf
FileTypeOutput = FileTypeOutput & "Mdb " & BlankFiller & vbtab & CtrArray(Imdb,1) & vbtab & CtrArray(Imdb,2) & vbcrlf
FileTypeOutput = FileTypeOutput & "Mp3 " & BlankFiller & vbtab & CtrArray(Imp3,1) & vbtab & CtrArray(Imp3,2) & vbcrlf
FileTypeOutput = FileTypeOutput & "Mpg " & BlankFiller & vbtab & CtrArray(Impg,1) & vbtab & CtrArray(Impg,2) & vbcrlf
FileTypeOutput = FileTypeOutput & "Pdf " & BlankFiller & vbtab & CtrArray(Ipdf,1) & vbtab & CtrArray(Ipdf,2) & vbcrlf
FileTypeOutput = FileTypeOutput & "Ppt " & BlankFiller & vbtab & CtrArray(Ippt,1) & vbtab & CtrArray(Ippt,2) & vbcrlf
FileTypeOutput = FileTypeOutput & "Pst " & BlankFiller & vbtab & CtrArray(Ipst,1) & vbtab & CtrArray(Ipst,2) & vbcrlf
FileTypeOutput = FileTypeOutput & "Wav " & BlankFiller & vbtab & CtrArray(Iwav,1) & vbtab & CtrArray(Iwav,2) & vbcrlf
FileTypeOutput = FileTypeOutput & "Wmv " & BlankFiller & vbtab & CtrArray(Iwmv,1) & vbtab & CtrArray(Iwmv,2) & vbcrlf
FileTypeOutput = FileTypeOutput & "Xls " & BlankFiller & vbtab & CtrArray(Ixls,1) & vbtab & CtrArray(Ixls,2) & vbcrlf
FileTypeOutput = FileTypeOutput & "Zip " & BlankFiller & vbtab & CtrArray(Izip,1) & vbtab & CtrArray(Izip,2) & vbcrlf



If OptArray(Ilist) = True Then
	fout2.writeline()
	fout2.close
End If

If OptArray(Ireport) = True Then
	fout1.writeline (ReportOutput)
	Fout1.writeline (FileTypeOutput)
	fout1.close
Else 
	MsgBox ReportOutput & FileTypeOutput				
End If 

If OptArray(Ierror) = True Then
	Fout3.Close
End If

If OptArray(Idepthopt) = True Then
	Fout4.Close
End If