In the last 2 years, no less than 3 times. Bothersone and time consuming to be done by hand.
Here is a script that I cobbled together to provide a spreadshhet as a good starting point.
Feel free to use it and modify it to your needs.
Thanks Everyone here at Tek-Tips!!
John Fuhrman "SparkByte"
CODE
'<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> ' NAME: List_Apps_On_Drive (prompts for drive letter and file extension).vbs ' ' AUTHOR: John F. Fuhrman III ' DATE : 1/22/2010 ' ' COMMENT: This script creates a new Excel Workbook and Spreadsheet ' for the Drive and File Extension the user specifies. ' The new Excel document is placed in the users "My Documents" ' directory by default. ' UPDATED: ' 2/8/2010 - John Fuhrman ' Added coments to code by sections. ' Converted user prompts to Functions. ' Added File Extension ' 2/19/2010 - John Fuhrman ' Added Date to filename. ' 3/5/2010 ' Decared all objects and variables and added ' a cleanup section to the end of the script. '<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><>
'<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> '<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> '<><> <><> '<><> Start of Main Script <><> '<><> <><> '<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> '<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><>
Option Explicit
Dim strComputer, objWMIService, objShell strComputer = "." ' use "." for local computer
'****************************************************************************** ' Prompted User Input '****************************************************************************** Dim strDrive, strExtension strDrive = funDriveSelect
strExtension = funFileExtention
'strDateInput = funDateInput
'****************************************************************************** ' Create Spreadsheet and Open Excel '****************************************************************************** Dim strExcelPath, objExcel, objWorksheet
' Spreadsheet file to be created. If strExtension = "*" Then strExcelPath = "File_Listing_for_Drive_" & strDrive & ".xls" Else strExcelPath = strExtension & "-File_Listing_for_Drive_" & strDrive & ".xls" End If ' Wscript.Echo strExcelPath
' Bind to Excel object. Set objExcel = CreateObject("Excel.Application") If Err.Number <> 0 Then Wscript.Echo "Excel application not found." Wscript.Quit End If
'Set this True if you would like to see the Spreadsheet being updated. objExcel.Visible = True
'Create a new workbook objExcel.Workbooks.Add
' Bind to worksheet. Set objWorksheet = objExcel.ActiveWorkbook.Worksheets(1) If strExtension = "*" Then objWorksheet.Name = "File Listing for Drive " & strDrive Else objWorksheet.Name = strExtension & "-File Listing for Drive " & strDrive End If
'****************************************************************************** 'Set Column Headings to Bold '****************************************************************************** objWorksheet.Range("A1:Z1").Font.Bold = True
'****************************************************************************** ' Format the spreadsheet. '****************************************************************************** Const xlAscending = 1 Const xlDescending = 2 Const xlYes = 1
'****************************************************************************** 'Defign Worksheet Ranges for Sorting and column sizing. '****************************************************************************** Dim objRange, objRange1, objRange2, objRange3, objRange4 Dim objRange5, objRange6, objRange7, objRange8, objRange9
Set objRange = objWorksheet.UsedRange Set objRange1 = objExcel.Range("A1") 'Sort by File Type Set objRange2 = objExcel.Range("B1") 'Sort by File Name Set objRange3 = objExcel.Range("C1") 'Sort by Extension Set objRange4 = objExcel.Range("D1") 'Sort by Drive Letter Set objRange5 = objExcel.Range("E1") 'Sort by Path (Folder) Set objRange6 = objExcel.Range("F1") 'Sort by File Size Set objRange7 = objExcel.Range("G1") 'Sort by Creation Date Set objRange8 = objExcel.Range("H1") 'Sort by Last Modified Set objRange9 = objExcel.Range("I1") 'Sort by File Owner
'****************************************************************************** ' Format FileSize with Commas '****************************************************************************** objRange6.EntireColumn.NumberFormat = "#,##0" objRange7.EntireColumn.NumberFormat = "mm/dd/yyyy hh:mm;@" objRange8.EntireColumn.NumberFormat = "mm/dd/yyyy hh:mm;@"
'****************************************************************************** 'Autofit all columns '****************************************************************************** objRange.EntireColumn.Autofit()
'****************************************************************************** ' Search for user specified files '****************************************************************************** Dim colFiles If strExtension = "*" Then Set colFiles = objWMIService. _ ExecQuery("SELECT * FROM CIM_DataFile" _ & " WHERE Drive = '" & strDrive & ":'") StrFileCount = colFiles.Count Else Set colFiles = objWMIService. _ ExecQuery("SELECT * FROM CIM_DataFile" _ & " WHERE Drive = '" & strDrive & ":'" _ & " AND Extension = '" & strExtension & "'") StrFileCount = colFiles.Count End If ' WScript.Echo "# of files found: " & colFiles.Count
'****************************************************************************** ' Fill in the open Excel Spreadsheet '****************************************************************************** Dim objFile, strOwner k = 2
For Each objFile in colFiles objWorksheet.Cells(k,1).Value = objFile.FileType 'A objWorksheet.Cells(k,2).Value = objFile.FileName 'B objWorksheet.Cells(k,3).Value = LCase(objFile.Extension) 'C objWorksheet.Cells(k,4).Value = UCase(objFile.Drive) 'D objWorksheet.Cells(k,5).Value = objFile.Path 'E objWorksheet.Cells(k,6).Value = objFile.FileSize 'F objWorksheet.Cells(k,7).Value = ConvWMITime(objFile.CreationDate) 'G objWorksheet.Cells(k,8).Value = ConvWMITime(objFile.LastModified) 'H strOwner = GetOwner(objFile.Name) 'I If strOwner = NULL Then objWorksheet.Cells(k,9).Value = "Unknown" ElseIf strOwner = "" Then objWorksheet.Cells(k,9).Value = "Unknown" Else objWorksheet.Cells(k,9).Value = strOwner End If k = k + 1 ' End If Next
'****************************************************************************** 'Autofit all columns '****************************************************************************** objRange.EntireColumn.Autofit()
'****************************************************************************** 'Display Count of ROWS Added '****************************************************************************** Dim strFileCountMSG, StrFileCount, k strFileCountMSG = msgbox(k - 2 & " ROWS written out of " & StrFileCount,_ 48,"ALERT")
'****************************************************************************** ' Save Spreadsheet and Quit Excel. '****************************************************************************** ' Save the spreadsheet and close the workbook. objExcel.ActiveWorkbook.SaveAs strExcelPath objExcel.ActiveWorkbook.Close objExcel.Application.Quit
'****************************************************************************** ' Clean up Objects and Variables we created. '******************************************************************************
Set objExcel = Nothing Set objWMIService = Nothing Set objShell = Nothing Set objWorksheet = Nothing Set colFiles = Nothing Set objFile = Nothing Set objRange = Nothing Set objRange1 = Nothing Set objRange2 = Nothing Set objRange3 = Nothing Set objRange4 = Nothing Set objRange5 = Nothing Set objRange6 = Nothing Set objRange7 = Nothing Set objRange8 = Nothing Set objRange9 = Nothing
'<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> '<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> '<><> <><> '<><> Start of Subroutines and Functions <><> '<><> <><> '<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> '<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><>
'****************************************************************************** ' Convert WMI Time Function '****************************************************************************** Public Function ConvWMITime(wmiTime) Dim yr, mo, dy, tm
yr = left(wmiTime,4) mo = mid(wmiTime,5,2) dy = mid(wmiTime,7,2) tm = mid(wmiTime,9,6)
ConvWMITime = mo & "/" & dy & "/" & yr & " " & FormatDateTime(left(tm,2) & _ ":" & Mid(tm,3,2) & ":" & Right(tm,2),3) End Function
'****************************************************************************** ' Convert WMI Time Function '****************************************************************************** Public Function dtConvert(strDateTime) Dim strConvertDT ' Convert File DateTime Stamp to a readable format strConvertDT = CDate(Mid(strDateTime, 5, 2) & "/" &_ Mid(strDateTime, 7, 2) & _ "/" & Left(strDateTime, 4) & " " &_ Mid (strDateTime, 9, 2) & ":" & _ Mid(strDateTime, 11, 2) & ":" & _ Mid(strDateTime, 13, 2)) dtConvert = strConvertDT End Function
'****************************************************************************** ' Get File Attribute "Owner" '****************************************************************************** Public Function GetOwner(strFile) Dim objCollection, objSID On Error Resume Next ' When processing multiple files make the WMI Local Computer Object Global! ' (Move outside the Function)
Set objCollection = objWMIService.ExecQuery _ ("ASSOCIATORS OF {Win32_LogicalFileSecuritySetting='" & strFile _ & "'} WHERE AssocClass=Win32_LogicalFileOwner ResultRole=Owner")
For Each objSID in objCollection GetOwner = objSID.AccountName Next
If VarType(GetOwner) = 0 Then GetOwner = "error" End If
On Error GoTo 0 End Function
'****************************************************************************** ' Convert Standard DateTime to WMI DateTime Function '****************************************************************************** Public Function ConvDateTimeWMI(strDateTime) Dim oswbemdtm set oswbemdtm=createobject("wbemscripting.swbemdatetime") oswbemdtm.setvardate strDateTime,true 'CONVERT_TO_LOCAL_TIME=true ConvDateTimeWMI = oswbemdtm set oswbemdtm = Nothing End Function
'****************************************************************************** ' Prompt User for Drive Letter to search. '****************************************************************************** Public Function funDriveSelect() Dim strDriveSelect, intReturn Const TimeOut = 20
strDriveSelect=UCase(InPutBox("Enter Drive Letter", "Search Drive", "O")) If strDriveSelect = "" Then intReturn = objShell.Popup("No User Input Found." & vbCrLf &_ "Would you like to Retry?" ,TimeOut, _ "Information Window", vbYesNo) Select CASE intReturn Case 1 ' Wscript.Echo "You clicked the OK button." Case 2 ' Wscript.Echo "You clicked the CANCEL button." Wscript.Quit Case 3 ' Wscript.Echo "You clicked the ABORT button." Case 4 ' Wscript.Echo "You clicked the RETRY button." subDriveSelect() Case 5 ' Wscript.Echo "You clicked the IGNOR button." Case 6 ' Wscript.Echo "You clicked the YES button." subDriveSelect() Case 7 ' Wscript.Echo "You clicked the NO button." Wscript.quit Case Else ' Wscript.echo "PopUp Timed Out!!" Wscript.quit End Select End If funDriveSelect = strDriveSelect End Function
'****************************************************************************** ' Prompt User for File Extention to search for. '****************************************************************************** Public Function funFileExtention() Dim strFileExtension, intReturn Const TIMEOUT = 20 ' Constant set for User prompt timeout
strFileExtension=UCase(InPutBox("Enter File Name Extension to search for.", _ "File Extension Search", "MDB")) If strFileExtension = "" Then intReturn = objShell.Popup("No User Input Found." & vbCrLf &_ "Would you like to Retry?" ,TimeOut, _ "Information Window", vbYesNo) Select CASE intReturn Case 1 ' Wscript.Echo "You clicked the OK button." Case 2 ' Wscript.Echo "You clicked the CANCEL button." Wscript.Quit Case 3 ' Wscript.Echo "You clicked the ABORT button." Case 4 ' Wscript.Echo "You clicked the RETRY button." subDriveSelect() Case 5 ' Wscript.Echo "You clicked the IGNOR button." Case 6 ' Wscript.Echo "You clicked the YES button." subDriveSelect() Case 7 ' Wscript.Echo "You clicked the NO button." Wscript.quit Case Else ' Wscript.echo "PopUp Timed Out!!" Wscript.quit End Select End If funFileExtention = strFileExtension End Function
'****************************************************************************** ' Prompt User for Date and Time to search for. '****************************************************************************** Public Function funDateInput() Dim strDate, intReturn Const TIMEOUT = 20 ' Constant set for User prompt timeout
strDate=InPutBox("Enter beginning Date and Time for Search." & VBcrlf & _ VBcrlf & "Ending Date and Time will be: " & vbCrLf &_ " " & Date() & " 12:00 AM", _ "Date Range Search", datevalue(dateadd("m",-1,Now())) _ & " 12:00 AM") If strDate = "" Then intReturn = objShell.Popup("No User Input Found." & vbCrLf &_ "Would you like to Retry?" ,TimeOut, _ "Information Window", vbYesNo) Select CASE intReturn Case 1 ' Wscript.Echo "You clicked the OK button." Case 2 ' Wscript.Echo "You clicked the CANCEL button." Wscript.Quit Case 3 ' Wscript.Echo "You clicked the ABORT button." Case 4 ' Wscript.Echo "You clicked the RETRY button." subDriveSelect() Case 5 ' Wscript.Echo "You clicked the IGNOR button." Case 6 ' Wscript.Echo "You clicked the YES button." subDriveSelect() Case 7 ' Wscript.Echo "You clicked the NO button." Wscript.quit Case Else ' Wscript.echo "PopUp Timed Out!!" Wscript.quit End Select funDateInput = strDate End If End Function
'****************************************************************************** ' Icons for objShell.Popup '****************************************************************************** ' STOP vbCritical 16 ' QUESTION MARK vbQuestion 32 ' EXCLAMATION MARK vbExclamation 48 ' INFORMATION vbInformation 64 '****************************************************************************** ' Button Set for objShell.Popup '****************************************************************************** ' OK vbOKOnly 0 ' OK and CANCEL vbOKCancel 1 ' ABORT, RETRY and IGNORE vbAbortRetryIgnore 2 ' YES, NO and CANCEL vbYesNoCancel 3 ' YES and NO vbYesNo 4 ' RETRY and CANCEL vbRetryCancel 5 '****************************************************************************** ' Default Buttons for objShell.Popup '****************************************************************************** ' LEFT vbDefaultButton1 0 ' MIDDLE vbDefaultButton2 256 ' RIGHT vbDefaultButton3 512 '****************************************************************************** ' Buttons Values for objShell.Popup '****************************************************************************** ' 1 VbOK OK ' 2 VbCancel Cancel ' 3 VbAbort Abort ' 4 VbRetry Retry ' 5 VbIgnore Ignore ' 6 VbYes Yes ' 7 VbNo No