VBScript drag&drop mass file renaming

gistfile1.bas

set fso = CreateObject("Scripting.FilesystemObject")
set shell = CreateObject("Wscript.Shell")
set args = wscript.Arguments
set re = New RegExp
set TodoList = CreateObject("Scripting.Dictionary")

appName = "File Rename Tool"
myname = wscript.scriptfullname
mypath = left(myname, instrrev(myname, "\") -1)
regkey = "HKCU\Software\vbsReplaceTool\"
MRUpattern = ""
MRUreplace = ""
FoldersInList = false

replaceCount = 0
deniedCount = 0

if args.count > 0 then

	on error resume next

	for each arg in args
		TodoList.Add arg, fso.GetFolder(arg)

		if err.number then
			err.clear
			TodoList.Add arg, fso.GetFile(arg)
		else
			FoldersInList = true
		end if
	next

	on error goto 0

else
	TodoList.Add mypath, fso.GetFolder(mypath)
end if

on error resume next
MRUpattern = shell.regRead(regkey & "MRUpattern")
MRUreplace = shell.RegRead(regkey & "MRUreplace")
on error goto 0

re.global = True

GetRegExPattern MRUpattern
replacewith = inputbox("Replace '/" & re.pattern & "/g' with?" & vbcrlf & vbcrlf & _
                          "Using sub-matches:" & vbcrlf & _
                          "$$" & vbtab & "literal $" & vbcrlf & _
                          "$&" & vbtab & "the match itself" & vbcrlf & _
                          "$`" & vbtab & "everything before $&" & vbcrlf & _
                          "$'" & vbtab & "everything after $&" & vbcrlf & _
                          "$n" & vbtab & "contents of n'th bracket (0 < n < 99)", appName & " - Enter Replacement String", MRUreplace)

if FoldersInList then
	answer = MsgBox("Recurse subfolders?", vbYesNoCancel + vbQuestion + vbDefaultButton2, appName)
	if Answer = vbCancel then WScript.Quit
else
	answer = vbNo
end if
DoRecursion = (answer = vbYes)

answer = MsgBox("Verify every single change?", vbYesNo + vbQuestion + vbDefaultButton2, appName)
DoVerify = (answer = vbYes)

if answer <> vbCancel then
	shell.RegWrite regkey & "MRUpattern", re.pattern, "REG_SZ"
	shell.RegWrite regkey & "MRUreplace", replacewith, "REG_SZ"

	for each obj in ToDoList.items
		Rename obj
		if DoRecursion and fso.FolderExists(obj.path) then Recurse obj, DoRecursion
	Next

	if deniedCount then
		MsgBox replaceCount & " items renamed," & vbcrlf & _
		       deniedCount & " errors while renaming (permission denied / read only)", vbExclamation, appName & " - Finished"
	else
		MsgBox replaceCount & " items renamed." & vbcrlf & _
		       "No errors.", vbInformation, appName & " - Finished"
	end if
end if

'------------------------------------------------------------------------------------------------------------------

Sub Recurse(folder, DoRecursion)

	if DoRecursion then
		for each subfolder in folder.Subfolders
			Rename subfolder
			Recurse subfolder, true
		next
	end if

	for each file in folder.files
		Rename file
	next
end sub

'-------------------------------------------------------------------------------------------------------------------

sub Rename(obj)

	On Error Resume Next

	Do
		re.Execute oldname

		If Err.Number Then
			answer = MsgBox("The RegEx pattern '" & re.pattern & "' contains an error: " & vbcrlf & vbcrlf & _
			                Err.description & vbcrlf & vbcrlf & _
			                "Do you want to correct it?", vbExclamation + vbYesNo, appName + " - RegEx Error")

			If answer = vbyes Then
				Err.Clear
				GetRegExPattern re.pattern
			Else
				WScript.Quit
			End If
		End If
	Loop Until Err.Number = 0

	On Error Goto 0

	oldname = obj.name
	newname = re.replace(oldname, replacewith)

	if newname <> obj.name then
		if DoVerify then
			answer = MsgBox("Old name:" & vbtab & oldname & vbcrlf & _
			                "New name:" & vbtab & newname, vbYesNoCancel + vbQuestion, appName & " - Verify Change")
			if answer = vbYes then
				MakeItSo = true
			elseif answer = vbno then
				MakeItSo = false
			else
				wscript.quit
			end if
		else
			MakeItSo = true
		end if

		if MakeItSo then
			on error resume next

			obj.name = oldname & ".tmp"     'falls sich die Namen nur in der Groß/Kleinschreibung unterscheiden
			obj.name = newname		'endgültiges Umbenennen

			if err.number then
				err.clear
				obj.name = oldname	'Zurück auf alten Namen ändern, damit es nicht weiterhin .tmp heißt
				deniedCount = deniedCount + 1
			else
				replaceCount = replaceCount + 1
			end if
		end if
	end if
end Sub

'-------------------------------------------------------------------------------------------------------------------

Sub GetRegExPattern(default)
	re.pattern = inputbox("Look for (RegEx - case sensitive, global)?" & vbcrlf & vbcrlf & _
    	                  "Example: b+([A-F0-7])*_$", appName & " - Enter RegEx", default)

	If re.pattern = "" Then WScript.Quit
End Sub