public
Last active

VBScript drag&drop mass file renaming

  • Download Gist
gistfile1.bas
Visual Basic
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167
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

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.