Create a gist now

Instantly share code, notes, and snippets.

VBScript drag&drop mass file renaming
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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment