‘Option Explicit
‘On Error Resume Next

‘USER ACCEPTANCE – SCRIPT DESCRIPTION
intAnswer = Msgbox(“This script lets you select a directory” & vbcrlf & _
“and asks you which type of files you want to keep in that directory.” & vbcrlf & _
“It will then proceed to remove all files (exept the ones you want to keep) ” & vbcrlf & _
“and will put them on a directory called removed_files.” & vbcrlf & _
“Do you understand and wish to continue?”,vbYesNo,”USER ACCEPTANCE”)
If intAnswer = vbYes Then

Set WshShell = WScript.CreateObject(“WScript.Shell”)
Set objFSO = WScript.CreateObject(“Scripting.FileSystemObject”)
Set strRootPath = objFSO.GetFolder(WshShell.CurrentDirectory)

‘SETUP LOG FILE.
strLogFile = “move_files.log”
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Set objLogFile = objFSO.OpenTextFile(strLogFile, ForWriting, True)
objLogFile.WriteLine “Generated on: ” & Date & ” ” & Time
objLogFile.WriteLine “”

‘FILE EXTENSION FROM USER INPUT
strFileExtension = InputBox(“Please type the file extension of the files you want to keep (i.e. JPG).”,”Extension of files to keep”)

‘SETUP FILE BROWSER AND DESTINATION.
Const MY_COMPUTER = &H11&
Const WINDOW_HANDLE = 0
Const NO_OPTIONS = 0
intAnswer = vbNo

Do While intAnswer = vbNo
Set objShell = CreateObject(“Shell.Application”)
Set objFolder = objShell.BrowseForFolder (WINDOW_HANDLE, “Select a folder or type the full path to folder:”, &H10&, objShell.Namespace( MY_COMPUTER ))

If objFolder Is Nothing Then
strSourceFolder = “”
intAnswer = vbYes
Else
Set objFolderItem = objFolder.Self
strSourceFolder = objFolderItem.Path

‘USER VERIFICATION
intAnswer = Msgbox(“You selected: ” & strSourceFolder & vbcrlf & _
“Is this the directory from which you want to remove all files ” & vblf & _
“that do not match the file extension ” & strFileExtension & ” ? “,vbYesNo,”User Verification”)

End If
Loop

‘START FILE COUNTER
intFileCounter = 0
intFolderCOunter = 0
intRemoveFileCounter = 0

‘VERIFY USER SELECTION
If objFSO.FolderExists(strSourceFolder) Then

‘DECLARE DESTINATION FOLDER
strDestinationFolder = strSourceFolder & “\removed_files”

‘CREATE SOURCE FOLDER and SUBFOLDERS LIST
Set objFolders = objFSO.GetFolder(strSourceFolder)
Set objSubfolders = objFolders.Subfolders

‘CREATE DESTINATION FOLDER
If Not objFSO.FolderExists(strDestinationFolder) Then
objFSO.CreateFolder(strDestinationFolder)
‘makeMsgBox = MsgBox(“Created” & strSourceFolder & “\remove_file\”)
End If

‘WRITE TO LOG FILE
objLogFile.WriteLine “Looped Thru:” & vbrc

‘CREATE FILE LIST FROM MAIN FOLDER
Set ArrMainFiles = objFSO.GetFolder(strSourceFolder).Files

‘LOOP THROUGH LIST
For Each File In ArrMainFiles

If Not UCase(Right(File.name,Len(strFileExtension))) = strFileExtension Then

‘RENAME DUPLICATE FILES
If objFSO.FileExists(strDestinationFolder & File.name) Then
makeMsgBox = MsgBox(“file: ” & strSourceFolder & File.name & ” exists already!, renaming to” & strDestinationFolder & “\” & “copy_” & File.name)
objFSO.MoveFile strSourceFolder & “\” & File.name, strDestinationFolder & “\” & “copy_” & File.name

If Err Then
objLogFile.WriteLine “File NOT moveded (” & Err.Number & “: ” & Err.Description & “): ” & objFile.Name & ” to ” & strDestinationFolder & strChildFolderName
End If

‘MOVE ALL OTHER FILE TYPES to the REMOVE_FILES folder
Else

‘CREATE SUBFOLDERS IN DESTINATION FOLDER
If Not objFSO.FolderExists(strDestinationFolder & “\” & objFSO.GetExtensionName(File.Name)) Then
objFSO.CreateFolder(strDestinationFolder & “\” & objFSO.GetExtensionName(File.Name))
End If

makeMsgBox = MsgBox(“Moving file: ” & strSourceFolder & File.name & vbcrlf & ” into to ” & strDestinationFolder & “\” & objFSO.GetExtensionName(File.Name) & “\”)
objFSO.MoveFile strSourceFolder & “\”& File.name, strDestinationFolder & “\” & objFSO.GetExtensionName(File.Name) & “\”

If Err Then
objLogFile.WriteLine “Other Files Types could not get moveded (” & Err.Number & “: ” & Err.Description & “): ” & objFile.Name & ” to ” & strDestinationFolder & strChildFolderName
Else
intRemoveFileCounter = intRemoveFileCounter + 1
End If
End If

‘REPORT ERROR
Else
‘objLogFile.WriteLine “File IGNORED (incorrect file extension): ” & objFile.Name
End If

intFileCounter = intFileCounter + 1
Next
‘END OF LOOP THROUGH LIST

If Err Then
objLogFile.WriteLine “File NOT deleted (” & Err.Number & “: ” & Err.Description & “): ” & File.Name & ” to ” & strDestinationFolder & strSubFolderPath
Else
objLogFile.WriteLine strSubFolderPath
End If

‘END OF MAIL FOLDER

‘LOOP TRHOUGH EACH SUBFOLDER
For Each Subfolder In objSubfolders
‘makeMsgBox = MsgBox(“In subfolder loop”)

‘SKIP DESTINATION FOLDER
If Not Subfolder.name = “removed_files” Then
strSubFolderPath = strSourceFolder & “\” & Subfolder.name & “\”
‘makeMsgBox = MsgBox(strSubFolderPath)

‘CREATE FILE LIST
Set ArrFiles = objFSO.GetFolder(strSubFolderPath).Files

‘LOOP THROUGH LIST
For Each File In ArrFiles

If Not UCase(Right(File.name,Len(strFileExtension))) = strFileExtension Then

‘RENAME DUPLICATE FILES
If objFSO.FileExists(strDestinationFolder & File.name) Then
makeMsgBox = MsgBox(“file: ” & strSubFolderPath & File.name & ” exists already!, renaming to” & strDestinationFolder & “\” & “copy_” & File.name)
objFSO.MoveFile strSubFolderPath & File.name, strDestinationFolder & “\” & “copy_” & File.name

If Err Then
objLogFile.WriteLine “File NOT moveded (” & Err.Number & “: ” & Err.Description & “): ” & objFile.Name & ” to ” & strDestinationFolder & strChildFolderName
End If

‘MOVE ALL OTHER FILE TYPES to the REMOVE_FILES folder
Else

‘CREATE SUBFOLDERS IN DESTINATION FOLDER
If Not objFSO.FolderExists(strDestinationFolder & “\” & objFSO.GetExtensionName(File.Name)) Then
objFSO.CreateFolder(strDestinationFolder & “\” & objFSO.GetExtensionName(File.Name))
End If

makeMsgBox = MsgBox(“Moving file: ” & strSubFolderPath & File.name & vbcrlf & ” into to ” & strDestinationFolder & “\” & objFSO.GetExtensionName(File.Name) & “\”)
objFSO.MoveFile strSubFolderPath & File.name, strDestinationFolder & “\” & objFSO.GetExtensionName(File.Name) & “\”

If Err Then
objLogFile.WriteLine “Other Files Types could not get moveded (” & Err.Number & “: ” & Err.Description & “): ” & objFile.Name & ” to ” & strDestinationFolder & strChildFolderName
Else
intRemoveFileCounter = intRemoveFileCounter + 1
End If
End If

‘REPORT ERROR
Else
‘objLogFile.WriteLine “File IGNORED (incorrect file extension): ” & objFile.Name
End If

intFileCounter = intFileCounter + 1
Next
‘END OF LOOP THROUGH LIST

If Err Then
objLogFile.WriteLine “File NOT deleted (” & Err.Number & “: ” & Err.Description & “): ” & File.Name & ” to ” & strDestinationFolder & strSubFolderPath
Else
objLogFile.WriteLine strSubFolderPath
End If

intFolderCounter = intFolderCounter + 1
End If
‘END SKIP DESTINATION FOLDER

Next
‘END LOOP THROUGH EACH SUBFOLDERS

Set objFolders = Nothing
Set objSubfolders = Nothing
Set ArrFiles = Nothing
Set ArrMainFiles = Nothing

makeMsgBox = MsgBox(“Finished!”)

‘MESSAGE FOR INVALID DIRECTORY
Elseif objFolder Is Nothing then
makeMsgBox = MsgBox( “No directory was selected. No files where moved. Exiting the Script.”)
objLogFile.WriteLine “No directory was selected. No files where moved.”
Else
makeMsgBox = MsgBox( “The directory selected does not exist: ” & strDestinationFolder)
objLogFile.WriteLine “The directory selected does not exist): ” & strDestinationFolder
End If

objLogFile.WriteLine(vbcrlf)
objLogFile.WriteLine “Scanned a total of ” & intFileCounter & ” files and a total of ” & intFolderCounter & ” subfolders.”
objLogFile.WriteLine “Moved a total of ” & intRemoveFileCounter & ” files to the removed_files folder.”

‘CLOSING TASKS
objLogFile.Close
Set objLogFile = Nothing
Set objFSO = Nothing
Set WshShell = Nothing
Set objShell = Nothing
Set strRootPath = Nothing
WScript.Quit

Else
makeMsgBox = MsgBox(“Canceled. No files where move. Exiting the script.”)
End If