Daily Dose of Excel

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

Tushar Mehta