This started off by helping myself to Dick’s code in ‘Removing Spaces from File Names’ (http://www.dailydoseofexcel.com/archives/2009/11/12/removing-spaces-from-file-names/) but quickly evolved to meet my own needs.
First, was the requirement to replace a certain text string by another. I added 3 parameters to the subroutine (Dirname, ReplaceWhat, and ReplaceBy). Also evident was that some files had leading spaces as well as multiple consecutive embedded blanks. I added an optional Boolean doTrim.
By using Dir rather than FileSystemObject I could restrict the returned file names to those that matched the search criteria. Consequently, it was certain that the file name would change.
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 |
Option Explicit Function addPathSeparator(ByVal DirName As String) Dim PS As String: PS = Application.PathSeparator If Right(DirName, Len(PS)) <> PS Then _ DirName = DirName & PS addPathSeparator = DirName End Function Sub FilenameReplace(ByVal DirName As String, ByVal ReplaceWhat As String, _ ByVal ReplaceBy As String, Optional ByVal doTrim As Boolean = False) Dim CurrName As String DirName = addPathSeparator(DirName) CurrName = Dir(DirName & "*" & ReplaceWhat & "*") Do While CurrName <> "" Dim NewName As String NewName = Replace(CurrName, ReplaceWhat, ReplaceBy) If doTrim Then NewName = Application.WorksheetFunction.Trim(NewName) 'VBA Trim leaves embedded multiple spaces alone; _ Excel's TRIM changes them to a single space On Error GoTo Catch1 Name DirName & CurrName As DirName & NewName GoTo Finally1 Catch1: Debug.Print "Error changing '" _ & CurrName & "' to '" & NewName & "'" & vbNewLine _ & " Error: " & Err.Description _ & " (" & Err.Number & ")" Resume Finally1 Finally1: CurrName = Dir() Loop End Sub |
Then, I found some files had characters just before the text to be replaced that were “special characters.” I added an optional boolean useRegExp together with the code to use a regular expression to do the cleaning.
So, a filename like ‘This is a file, change me.xls’ should become ‘This is a file changed you.xls’
Unlike the above code, Dir could not be used to restrict the filenames since it does not support regular expressions. Consequently, I included a test to ensure that the new name differed from the old name before using the Name statement to rename the file.
The code below has been lightly tested as in it worked for the few directories that I had to process, each with a different set of rules.
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 |
Option Explicit #Const EarlyBind = False Sub FilenameReplaceRegExp(ByVal DirName As String, _ ByVal ReplaceWhat As String, ByVal ReplaceBy As String, _ Optional ByVal doTrim As Boolean = False, _ Optional useRegExp As Boolean = False) #If EarlyBind Then Dim RE As RegExp #Else Dim RE As Object #End If If useRegExp Then #If EarlyBind Then Set RE = New RegExp #Else Set RE = CreateObject("VBScript.RegExp") #End If RE.IgnoreCase = True RE.Global = True RE.Pattern = ReplaceWhat End If Dim CurrName As String DirName = addPathSeparator(DirName) CurrName = Dir(DirName & "*.*") Do While CurrName <> "" Dim NewName As String If useRegExp Then NewName = RE.Replace(CurrName, ReplaceBy) Else NewName = Replace(CurrName, ReplaceWhat, ReplaceBy) End If If doTrim Then _ NewName = Application.WorksheetFunction.Trim(NewName) 'VBA Trim leaves embedded multiple spaces alone; _ Excel's TRIM changes them to a single space If NewName <> CurrName Then On Error GoTo Catch1 Name DirName & CurrName As DirName & NewName GoTo Finally1 Catch1: Debug.Print "Error changing '" _ & CurrName & "' to '" & NewName & "'" & vbNewLine _ & " Error: " & Err.Description _ & " (" & Err.Number & ")" Resume Finally1 Finally1: End If CurrName = Dir() Loop End Sub |
Invoke the above subroutine as
1 |
FilenameReplaceRegExp "c:dir to check", "W*change me", "changed you", True, True |
I’d never considered using #Const to switch between Early and Late binding. Great idea!
instead of your function addpathseparator
DirName = Replace(DirName & .PathSeparator, String(2, .PathSeparator), .PathSeparator)
End With
The advantages of using a single bushy procedure vs a wrapper udf calling one of two simpler, specific procedures (one using regexps the other not) is unclear to me.
But then using VBA for this sort of thing rather than shell scripts, even batch files, seems pointless. While I could use batch files to generate Fibonacci numbers, I wouldn’t. While I could use VBA to rename files, I wouldn’t. Extolling the virtues of driving screws with hammers.
Rob: I spent several formative years programming in languages with a very powerful compile-time language – extending well beyond the simple #If capabilities supported by VB. So, one could say the use of compiler directives is second nature to me.
In addition to using it for early/late binding, I also use compiler directives to “remove” code without actually removing it and testing new code while leaving the old code alone.