'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