Hi I have a script that was being followed and adjusted in this forum, however for some reason it no longer appears.
the script is this:
......................................................................................................................
'~~Author~~. Mark Creamer
'~~Email_Address~~. mcse1@attglobal.net
'~~Script_Type~~. vbscript
'~~Sub_Type~~. FileSystem
'~~Keywords~~. list files, recursive, Excel, FileSystemObject, extension
'~~Comment~~.
'Recursively search a directory tree looking for files that have a
'specified extension, and place those file names (along with details) into
'an Excel spreadsheet.
'~~Script~~.
'Script Name: ListByExtension.vbs
'
'Author: Mark Creamer (see acknowledgements) mcse1@attglobal.net
'
'Date Created: 01-12-2000
'
'Type: VBScript
'
'Purpose:
'Recursively search a directory of files for a match by extension
' and place the results into an Excel spreadsheet
'
'Usage:
'Simply double-click the vbs file. The script will prompt for
' a directory to begin searching. It will then continue
' to search recursively and place all matched files (match
' by extension) in the spreadsheet along with file details.
'
'Requires:
'The usual VBScript requirements plus Excel. Tested with Excel 2000,
' but should work with other versions as well.
'
'* Acknowledgements:
' Numerous people from this site as well as other friends and
' colleagues on the Internet assisted with this script.
' Snippets for the recursive processing were borrowed from several scripts
' on this site, and a colleague provided the logic to isolate the
' extension (Thanks Josh!)
' Disclaimer - Please test the script carefully on a local machine before running
' on a network.
'
'Note:
' This is a first effort for me. If anyone more experienced has some
' suggestions on logic, enhancements, etc., please let me know.
'
Dim FSO, WSH, objDirectory, objFile, TheFiles
'
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WSH = CreateObject("Wscript.Shell")
objextension = InputBox("Enter extension" & vbcrlf & vbcrlf & "Ex..." & vbcrlf & "mp3" & vbcrlf & "bmp" & vbcrlf & "exe")
Set objDirectory = FSO.GetFolder("\\gandalf\pupils")
Set TheFiles = objDirectory.Files
'
' Create and Set up Excel Objects
Column = 1
Row = 1
RowErr = 1
Set objXL = WScript.CreateObject("Excel.Application")
'
objXL.Workbooks.Add
objXL.Cells(1,Column).Value = "Parent Folder"
objXL.Cells(1,Column+1).Value = "File Name"
objXL.Cells(1,Column+2).Value = "File Size"
objXL.Cells(1,Column+3).Value = "Date Created"
objXL.Cells(1,Column+4).Value = "Date Last Modified"
objXL.Visible = True
'
WorkWithSubFolders objDirectory
'
Sub WorkWithSubFolders(objDirectory)
Dim MoreFolders, TempFolder
ListFilesWithExtension objDirectory
Set MoreFolders = objDirectory.SubFolders
For Each TempFolder In MoreFolders
WorkWithSubFolders TempFolder
Next
End Sub
'
'ListFilesWithExtension objDirectory
'
Sub ListFilesWithExtension(objDirectory)
Dim TheFiles
Set TheFiles = objDirectory.Files
For Each objFile in TheFiles
strExt = fso.GetExtensionName(objFile.Path)
'msgbox objFile.Path
If (strExt = objextension) Then
Row = Row+1
objXL.Cells(Row,Column).Value = objDirectory
objXL.Cells(Row,Column+1).Value = objFile.Name
objXL.Cells(Row,Column+2).Value = Formatnumber(objFile.Size /1024/1024,2) & " MG"
objXL.Cells(Row,Column+3).Value = objFile.DateCreated
objXL.Cells(Row,Column+4).Value = objFile.DateLastModified
End If
Next
End Sub
'
MsgBox("All Done!")
WScript.Quit
......................................................................................................................
The script as now changed works fine and finds all the files and puts them into a workbook, However I would like to have an option to having found the files and put them into a workbook go on to DELETE them.
Thanks stressed school techy.
the script is this:
......................................................................................................................
'~~Author~~. Mark Creamer
'~~Email_Address~~. mcse1@attglobal.net
'~~Script_Type~~. vbscript
'~~Sub_Type~~. FileSystem
'~~Keywords~~. list files, recursive, Excel, FileSystemObject, extension
'~~Comment~~.
'Recursively search a directory tree looking for files that have a
'specified extension, and place those file names (along with details) into
'an Excel spreadsheet.
'~~Script~~.
'Script Name: ListByExtension.vbs
'
'Author: Mark Creamer (see acknowledgements) mcse1@attglobal.net
'
'Date Created: 01-12-2000
'
'Type: VBScript
'
'Purpose:
'Recursively search a directory of files for a match by extension
' and place the results into an Excel spreadsheet
'
'Usage:
'Simply double-click the vbs file. The script will prompt for
' a directory to begin searching. It will then continue
' to search recursively and place all matched files (match
' by extension) in the spreadsheet along with file details.
'
'Requires:
'The usual VBScript requirements plus Excel. Tested with Excel 2000,
' but should work with other versions as well.
'
'* Acknowledgements:
' Numerous people from this site as well as other friends and
' colleagues on the Internet assisted with this script.
' Snippets for the recursive processing were borrowed from several scripts
' on this site, and a colleague provided the logic to isolate the
' extension (Thanks Josh!)
' Disclaimer - Please test the script carefully on a local machine before running
' on a network.
'
'Note:
' This is a first effort for me. If anyone more experienced has some
' suggestions on logic, enhancements, etc., please let me know.
'
Dim FSO, WSH, objDirectory, objFile, TheFiles
'
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WSH = CreateObject("Wscript.Shell")
objextension = InputBox("Enter extension" & vbcrlf & vbcrlf & "Ex..." & vbcrlf & "mp3" & vbcrlf & "bmp" & vbcrlf & "exe")
Set objDirectory = FSO.GetFolder("\\gandalf\pupils")
Set TheFiles = objDirectory.Files
'
' Create and Set up Excel Objects
Column = 1
Row = 1
RowErr = 1
Set objXL = WScript.CreateObject("Excel.Application")
'
objXL.Workbooks.Add
objXL.Cells(1,Column).Value = "Parent Folder"
objXL.Cells(1,Column+1).Value = "File Name"
objXL.Cells(1,Column+2).Value = "File Size"
objXL.Cells(1,Column+3).Value = "Date Created"
objXL.Cells(1,Column+4).Value = "Date Last Modified"
objXL.Visible = True
'
WorkWithSubFolders objDirectory
'
Sub WorkWithSubFolders(objDirectory)
Dim MoreFolders, TempFolder
ListFilesWithExtension objDirectory
Set MoreFolders = objDirectory.SubFolders
For Each TempFolder In MoreFolders
WorkWithSubFolders TempFolder
Next
End Sub
'
'ListFilesWithExtension objDirectory
'
Sub ListFilesWithExtension(objDirectory)
Dim TheFiles
Set TheFiles = objDirectory.Files
For Each objFile in TheFiles
strExt = fso.GetExtensionName(objFile.Path)
'msgbox objFile.Path
If (strExt = objextension) Then
Row = Row+1
objXL.Cells(Row,Column).Value = objDirectory
objXL.Cells(Row,Column+1).Value = objFile.Name
objXL.Cells(Row,Column+2).Value = Formatnumber(objFile.Size /1024/1024,2) & " MG"
objXL.Cells(Row,Column+3).Value = objFile.DateCreated
objXL.Cells(Row,Column+4).Value = objFile.DateLastModified
End If
Next
End Sub
'
MsgBox("All Done!")
WScript.Quit
......................................................................................................................
The script as now changed works fine and finds all the files and puts them into a workbook, However I would like to have an option to having found the files and put them into a workbook go on to DELETE them.
Thanks stressed school techy.