'Generates a CSV report on all files in a directory.
'Drop a folder on this script or browse for it. A CSV 
'file with the same base name and location as the script 
'will be generated to show you all the file details.

Option Explicit

Main

Sub Main
Dim fs, sh, shFol, shFile, strOut, strFolder, intElement
	Set fs = CreateObject("Scripting.FileSystemObject")
	Set sh = CreateObject("Shell.Application")
	'Delete existing CSV report
	If fs.FileExists(FileNameLikeMine("csv")) Then fs.DeleteFile FileNameLikeMine("csv")
	'Get the folder you want info on
	If WScript.Arguments.Count = 1 Then
		strFolder = WScript.Arguments(0)
	Else
		strFolder = BrowseForFolder("Location of Files")
	End If
	If strFolder = "" Then Exit Sub
	Set shFol = sh.Namespace(strFolder)
	'Write the header (element number & names of the elements) to the CSV report
	strOut = ""
	For intElement = 0 to 37
		If strOut <> "" Then strOut = strOut & ","
		strOut = strOut & "[" & intElement & "] " & shFol.GetDetailsOf(shFol.Items, intElement)
	Next
	AddLineToCsvFile strOut
	'Write the actual data elements for each file
	strOut = ""
	For Each shFile in shFol.Items
		'If LCase(Right(shFol.GetDetailsOf(shFile, 0), 4)) = ".exe" Then
			Status shFol.GetDetailsOf(shFile, 0)
			If strOut <> "" Then strOut = strOut & vbCrLf
			For intElement = 0 to 37
				If strOut <> "" Then strOut = strOut & ","
				strOut = strOut & Replace(shFol.GetDetailsOf(shFile, intElement), ",", "")
			Next
			AddLineToCsvFile strOut
			strOut = ""
		'End If
	Next
End Sub

Function BrowseForFolder(strPrompt)
'Uses the "Shell.Application" (only present in Win98 and newer)
'to bring up a file/folder selection window. Falls back to an
'ugly input box under Win95.
'Shell32.ShellSpecialFolderConstants
Const ssfPERSONAL = 5 'My Documents
Const ssfDRIVES = 17 'My Computer
Const SFVVO_SHOWALLOBJECTS = 1
Const SFVVO_SHOWEXTENSIONS = 2 
	Dim sh, fol, fs, lngView, strPath
	Set sh = CreateObject("Shell.Application")
	If Instr(TypeName(sh), "Shell") = 0 Then
		BrowseForFolder = InputBox(strPrompt, "Select Folder", CreateObject("Scripting.FileSystemObject").GetParentFolderName(WScript.ScriptFullName))
		Exit Function
	End If
	Set fs = CreateObject("Scripting.FileSystemObject")
	lngView = SFVVO_SHOWALLOBJECTS Or SFVVO_SHOWEXTENSIONS
	strPath = ""
	Set fol = sh.BrowseForFolder(&0, strPrompt, lngView, ssfDRIVES)
	Err.Clear
	On Error Resume Next
	strPath = fol.ParentFolder.ParseName(fol.Title).Path
	'An error occurs if the user selects a drive instead of a folder
	If Err.Number <> 0 Then
		BrowseForFolder = Left(Right(fol.Title, 3), 2) & "\"
	Else
		BrowseForFolder = strPath
	End If
End Function

Sub Status(strMessage)
	If Lcase(Right(Wscript.FullName, 12)) = "\cscript.exe" Then
		Wscript.Echo strMessage
	End If
End Sub

Sub AddLineToCsvFile(strText)
Dim fs 'As Scripting.FileSystemObject
Dim ts 'As Scripting.TextStream
Const ForAppending = 8
	Set fs = CreateObject("Scripting.FileSystemObject")
	Set ts = fs.OpenTextFile(Left(Wscript.ScriptFullName, InstrRev(Wscript.ScriptFullName, ".")) & "csv", ForAppending, True)
	ts.WriteLine strText
	ts.Close
End Sub

Function FileNameLikeMine(strFileExtension) 'As String
'Returns a file name the same as the script name except
'for the file extension. 
Dim fs 'As Object
Dim strExtension 'As String
	Set fs = CreateObject("Scripting.FileSystemObject")
	strExtension = strFileExtension
	If Len(strExtension) < 1 Then strExtension = "txt"
	If strExtension = "." Then strExtension = "txt"
	If Left(strExtension,1) = "." Then strExtension = Mid(strExtension, 2)
	FileNameLikeMine = Left(Wscript.ScriptFullName, InstrRev(Wscript.ScriptFullName, ".")) & strExtension
End Function