Changing names of some files in a directory
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.
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.
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
FilenameReplaceRegExp "c:\dir to check", "\W*change me", "changed you", True, True













