mistux
Site Admin
Joined: 25 Jun 2004
Posts: 1042
Location: South Bend, Indiana USA
|
 Posted: Mon Sep 18, 2006 8:30 am Post subject: Rename Multiple Files Based Upon Re Ex Search Pattern |
 |
|
Rename Multiple Files Based Upon Regular Expression Search Pattern
| Code: |
~~Author~~. Frode Dragland
'~~Email_Address~~. frode_dragland@hotmail.com
'~~Script_Type~~. VB Script
'~~Sub_Type~~.
'~~Prerequisites~~. VBScript 5.6.
'~~Version~~. 1.1
'~~Version_History~~. 1.0 - 1.1 Fixed problem with international characters in filename.
' NB! You will find that the preview in NotePad may be a bit misleading
' for international characters, this is due to different character
' sets used in NotePad and DOS. It you are using Win9x then you may
' use Edit.com to view the batchfile using DOS character set.
'~~Keywords~~. Rename files, RegExp object, FileSystemObject, WshShell.Run, CreateTextFile
'~~Description~~. Rename files based upon RegExp search pattern and RegExp.Replace method.
' To use the script do the following:
' Drop files (via Explorer) on the script file or pass file names by command line.
' Enter a RegExp pattern to search for in the first input box.
' Enter the replacement text in the second input box.
' A standard DOS batch file is created and previewed in Notepad where you
' may also edit and save any changes before closing the file.
' When the batch file is closed you are given the choice to run the
' batch file immediately. If you do this, a command prompt will run the
' batch file and remain on the screen to show you any errors.
'~~Remaining_Bugs~~.
'~~Ideas for improvement Add a method to allow input of incremental numbers in the replacement string for file names.
' E.g. File 001.jpg, File 002.jpg and so on.
' Disclaimer:
' ------------------
' You have a royalty-free right to use, modify, reproduce and distribute
' this source (and/or any modified version) in any way you find
' useful, provided that you agree that the author of this script
' has no warranties, obligations or liability for the source or any
' damage use of this source may cause.
' ------------------
'========= Declarations =================
Option Explicit
'Define global variables
Dim oFSO
Dim oWshShell
Dim aOldFileNames() 'Dynamic Array with Wscript.Arguments.Unnamed content, normal array
Dim aNewFileNames 'Dynamic Array with changed names after RegExp.Replace
Dim aArguments 'Array with Wscript.Arguments.Unnamed collection, special properties apply
Dim iCounter 'Loop counter
Dim oBatchFile 'Handle to batch file
Dim sBatchFileName 'String with file name of batch file
Dim iRetVal 'Return value from MsgBox
Dim sSearch 'Pattern to search for
Dim sReplace 'Replacement string/expression
Dim sRenFileCmd 'Temp variable with rename command for current file
Const RenameCmd = "rename" 'This is the command which does the work in our DOS file
'========= Main code =================
'Initialize
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oWshShell = WScript.CreateObject("WScript.Shell")
'Check for script version 5.6 since our function needs this
'for WScript.Arguments.Unnamed collection
If ScriptEngineMajorVersion < 5 Or (ScriptEngineMajorVersion=5 And ScriptEngineMinorVersion<6) Then
MsgBox "This script requires VBScript version 5.6 or higher." & vbCrLf _
& "Script will now end." & vbCrLf _
,vbSystemModal + vbCritical,Wscript.ScriptName
Wscript.Quit(1)
End If
'Read input (files dropped on script file or sent by command line)
'The quotes around file names will be removed in the Unnamed collection
Set aArguments = WScript.Arguments.Unnamed
If aArguments.Count = 0 Then
MsgBox "No files are dropped onto the script or passed by command line." & vbCrLf & vbCrLf _
& "Script will now end." _
,vbSystemModal + vbCritical,Wscript.ScriptName
WScript.Quit(1)
End If
'Create an (normal) array of files to work with
'The Unnamed collection is not an normal array so we cannot use it directly
ReDim Preserve aOldFileNames(aArguments.Count - 1)
For iCounter = 0 To (aArguments.Count - 1)
aOldFileNames(iCounter) = aArguments(iCounter)
Next
'Ask for a search pattern
'Return value will be vbEmpty if user canceled, while an empty string ("")
'means no input and is not valid.
sSearch = ""
Do Until (sSearch = vbEmpty) Or (sSearch <> "")
sSearch = InputBox("Enter RegExp search pattern." & vbCrLf & vbCrLf _
& "All expressions defined in VBscript RegExp pattern may be used. " _
& "Please note that several characters (like ""."" and ""\"") have a special function in a RegExp pattern." & vbCrLf & vbCrLf _
& "Please check VBScript documentation if needed." & vbCrLf _
,WScript.ScriptName,"")
Loop
If sSearch = vbEmpty Then
Call oWshShell.Popup("Canceled. Script ending." & vbCrLf & vbCrLf _
,2,Wscript.ScriptName,vbInformation)
WScript.Quit(0)
End If
'Ask for a replacement string
'Value may be an empty string
sReplace = InputBox("Enter replacement string." & vbCrLf & vbCrLf _
& "This may be a normal string or a reference to a subexpressions in the pattern as defined in the ReExp.Replace method." & vbCrLf & vbCrLf _
& "Please check VBScript documentation if needed." & vbCrLf _
,WScript.ScriptName, "")
If sReplace = vbEmpty Then
Call oWshShell.Popup("Canceled. Script ending." & vbCrLf & vbCrLf _
,2,Wscript.ScriptName,vbInformation)
WScript.Quit(0)
End If
'Feed the array, the searchpattern and the replacement string to our replacement function
'Returns a new array with corrected file names
aNewFileNames = ReplaceFileNames(aOldFileNames,sSearch,sReplace)
'Now we create a batch file with all changes we wish to perform
'Old batchfile is overwritten.
On Error Resume Next
'Create a batch file named the same as this VBScript-file but with ending ".bat"
'Put it in the same folder as script file
sBatchFileName = oFSO.BuildPath(GetScriptFolder,oFSO.GetBaseName(WScript.ScriptName) & ".bat")
Set oBatchFile = oFSO.CreateTextFile(sBatchFileName, True, False)
'Did we manage to create the file ?
If Err.Number <> 0 Then
MsgBox "Error creating batch file. Script cannot continue." & vbCrLf & vbCrLf _
& "Check that you have write access to " & sBatchFileName _
,vbSystemModal + vbCritical,Wscript.ScriptName
WScript.Quit(1)
End If
On Error Goto 0
'Write general info to top of batch file
oBatchFile.WriteLine("REM This DOS batch file was generated by " & Chr(34) & Wscript.ScriptName & Chr(34))
oBatchFile.WriteLine("REM The full path to this file is " & Chr(34) & sBatchFileName & Chr(34))
oBatchFile.WriteLine("REM ")
oBatchFile.WriteLine("REM If you want to review and make changes, feel free to do it now !")
oBatchFile.WriteLine("REM ")
oBatchFile.WriteLine("REM You will be asked to run this file when you close it.")
oBatchFile.WriteLine("REM As with any other batch file you may also run it later by doubleclicking it.")
oBatchFile.WriteBlankLines(2)
'Close file to flush output in cache correctly
oBatchFile.Close
'Write changed filenames to batch file using DOS output redirection
'Quick and dirty method to create batch file but this avoids
'problem with international characters in text file not working in DOS
'since oWshShell.Run handles this ... :) Yepp, there is probably a better way to do this.
sBatchFileName = Get83FileName(sBatchFileName)
For iCounter = 0 To UBound(aOldFileNames)
If aOldFileNames(iCounter) <> aNewFileNames(iCounter) Then
sRenFileCmd = (Trim(RenameCmd) & " " & Chr(34) & aOldFileNames(iCounter) & Chr(34) & " " & Chr(34) & oFSO.GetFileName(aNewFileNames(iCounter)) & Chr(34))
'Add this command to text file using standard DOS output redirect
Call oWshShell.Run("%comspec% /c echo " & sRenFileCmd & " >> " & sBatchFileName,0,True)
End If
Next
'Display batch file in Notepad for review and ask user if file should be run when it is closed
iRetVal = oWshShell.Run("%comspec% /c Notepad.exe " & Chr(34) & sBatchFileName & Chr(34),0,True)
iRetVal = MsgBox("Do you want to run this batch file now ?",vbYesNo + vbSystemModal,oFSO.GetFileName(sBatchFileName))
If iRetVal = vbYes Then
iRetVal = oWshShell.Run("%comspec% /k " & Chr(34) & sBatchFileName & Chr(34),1,False)
End If
'Clean up
Set oFSO = Nothing
Set oWshShell = Nothing
Set oBatchFile = Nothing
'========= Subs and functions ================
Function GetScriptFolder
'Version 1.0
'Returns the path to parent folder of current script
Dim oFSO
Set oFSO = CreateObject("Scripting.FileSystemObject")
'Get the path name to folder
GetScriptFolder = oFSO.GetParentFolderName(WScript.ScriptFullName)
Set oFSO = Nothing
End Function
Function ReplaceFileNames(ByVal aFileArray, ByVal sSearchPattern, ByVal sReplacement)
'Version 1.0
'Returns an array with replaced filenames.
'The file path is not changed, only filenames.
Dim iCounter 'Loop counter
Dim oFSO 'FileSystemObject
Dim aReturnArray() 'Dynamic array to hold return values
Dim sBuffer 'Temp variable
Set oFSO = CreateObject("Scripting.FileSystemObject")
ReDim aReturnArray(UBound(aFileArray)) 'Increase size to match file list
'Loop through all files in the array
For iCounter = 0 To UBound(aFileArray)
'Change the file name
sBuffer = ReplacePattern(oFSO.GetFileName(aFileArray(iCounter)),sSearchPattern,sReplacement)
'Store the new file name in return array along with full path
aReturnArray(iCounter) = oFSO.BuildPath(oFSO.GetParentFolderName(aFileArray(iCounter)), sBuffer)
Next
'Return array to function call
ReplaceFileNames = aReturnArray
'Clean up
Set oFSO = Nothing
End Function
Function ReplacePattern(ByVal sInput, ByVal sSearchPattern, ByVal sReplacement)
'Version 1.0
'Perform string replacement on input string using the search pattern and replacement
'string specified. Uses RegExp.Replace object from VBScript
Dim oRegEx 'Create variables.
Set oRegEx = New RegExp 'Create regular expression.
oRegEx.IgnoreCase = True 'Make case insensitive.
oRegEx.Global = True 'Replace all matches
oRegEx.Pattern = sSearchPattern 'Set pattern.
'Return string value to function call
ReplacePattern = oRegEx.Replace(sInput, sReplacement)
Set oRegEx = Nothing
End Function
Function Get83FileName(sFilePath)
'Version 1.0
'Returns the DOS 8.3 equivalent file name/path of input file
Dim oFSO, oFile
Set oFSO = CreateObject("Scripting.FileSystemObject")
Get83FileName = vbNull
On Error Resume Next
If oFSO.FileExists(sFilePath) Then
Set oFile = oFSO.GetFile(sFilePath)
Get83FileName = oFile.ShortPath
Set oFile = Nothing
End If
On Error Goto 0
Set oFSO = Nothing
End Function
|
|
|
FAQ
Search
Memberlist
Usergroups
Register
Profile
Log in to check your private messages
Log in
