VBS Script To Locate Files On A Drive With A Specified File Extension And Write To Excel

 

This VBS script will allow you to enter a machine name, drive letter and file extension to search for and write the results to an excel spreadsheet. It will capture the File name, File size, File path, Creation date and last accessed date.

 

The script can be used to find Mp3 files on a remote machine or find all of the Outlook Pst files on a user file share.

 

VBS Script:

 

strComputer = InputBox ("Enter Machine Name")

strDrive = InputBox ("Enter Drive Letter")

strExtension = InputBox ("Enter File Extension")

 

Set objExcel = CreateObject("Excel.Application")

objExcel.Visible = True

objExcel.Workbooks.Add

intRow = 2

 

objExcel.Cells(1, 1).Value = "File Name"

objExcel.Cells(1, 2).Value = "File Size"

objExcel.Cells(1, 3).Value = "Path"

objExcel.Cells(1, 4).Value = "Creation Date"

objExcel.Cells(1, 5).Value = "Last Accessed"

 

Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")

Set colFiles = objWMIService.ExecQuery _

("Select * from CIM_DataFile Where Drive = '" & strDrive & "' And Extension = '" & strExtension & "'")

For Each objItem in colFiles

 

objExcel.Cells(intRow, 1).Value = objItem.FileName

objExcel.Cells(intRow, 2).Value = FormatNumber(objItem.FileSize/1024/1024,1) & " MB"

objExcel.Cells(intRow, 3).Value = objItem.Path

objExcel.Cells(intRow, 4).Value = ConvWbemTime(objItem.CreationDate)

objExcel.Cells(intRow, 5).Value = ConvWbemTime(objItem.LastAccessed)

intRow = intRow + 1

Next

 

Function ConvWbemTime(IntervalFormat)

sMonth = mid(IntervalFormat,5,2)

sDay = mid(IntervalFormat,7,2)

sYear = mid(IntervalFormat,1,4)

sHour = mid(IntervalFormat,9,2)

sMinutes = mid(IntervalFormat,11,2)

sSeconds = mid(IntervalFormat,13,2)

ConvWbemTime =  sMonth & "-" & sDay & "-" & sYear & " " & sHour & ":" & sMinutes & ":" & sSeconds

End Function

 

objExcel.Range("A1:E1").Select

objExcel.Selection.Interior.ColorIndex = 19

objExcel.Selection.Font.ColorIndex = 11

objExcel.Selection.Font.Bold = True

objExcel.Cells.EntireColumn.AutoFit

 

Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)

Set objRange = objExcel.Range("A2")

objRange.Sort objRange,1,,,,,,1

 

MsgBox "Done"

 

 

 

 

Published Saturday, March 22, 2008 6:19 PM by dhite
Filed under:

Comments

No Comments