Navigation
Install the app
How to install the app on iOS
Follow along with the video below to see how to install our site as a web app on your home screen.
Note: This feature may not be available in some browsers.
More options
-
Congratulations TouchToneTommy on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!
You are using an out of date browser. It may not display this or other websites correctly.
You should upgrade or use an alternative browser.
You should upgrade or use an alternative browser.
List all files of type XXX on drive X
File and folder security
List all files of type XXX on drive X
by
sparkbyte
Posted
(Edited
)
How many times do we get this request??
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"
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
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set objShell = CreateObject("Wscript.Shell")
'******************************************************************************
' 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
'******************************************************************************
' Populate spreadsheet cells with user attributes.
'******************************************************************************
objWorksheet.Cells(1,1).Value = "File Type" 'Cell A1
objWorksheet.Cells(1,2).Value = "File Name" 'Cell B1
objWorksheet.Cells(1,3).Value = "File Extension" 'Cell C1
objWorksheet.Cells(1,4).Value = "Drive" 'Cell D1
objWorksheet.Cells(1,5).Value = "Folder" 'Cell E1
objWorksheet.Cells(1,6).Value = "File Size" 'Cell F1
objWorksheet.Cells(1,7).Value = "Creation Date" 'Cell G1
objWorksheet.Cells(1,8).Value = "Last Modified" 'Cell H1
objWorksheet.Cells(1,9).Value = "File Owner" 'Cell I1
objWorksheet.Cells(1,10).Value = "Point of Contact" 'Cell J1
objWorksheet.Cells(1,11).Value = "POC Contact Number" 'Cell K1
objWorksheet.Cells(1,12).Value = "File Status" 'Cell L1
'******************************************************************************
'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()
'******************************************************************************
'Set sorting order
'******************************************************************************
' objRange.Sort objRange1, xlAscending, , , , , , xlYes
' objRange.Sort objRange2, xlAscending, , , , , , xlYes
' objRange.Sort objRange3, xlAscending, , , , , , xlYes
' objRange.Sort objRange4, xlAscending, , , , , , xlYes
objRange.Sort objRange5, xlAscending, objRange1, , xlDescending, _
objRange8, xlDescending, xlYes
'******************************************************************************
'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
strComputer = Null
strDrive = Null
strExtension = Null
strExcelPath = Null
k = Null
StrFileCount = Null
strFileCountMSG = Null
'<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><>
'<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><>
'<><> <><>
'<><> 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)
'strComputer = "."
'Set objWMIService = GetObject("winmgmts:" _
' & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
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
Please Note: 1 is Bad, 10 is Good :-)
Part and Inventory Search
-
This site uses cookies to help personalise content, tailor your experience and to keep you logged in if you register.
By continuing to use this site, you are consenting to our use of cookies.