View Single Post
 
Old 05-13-2022, 09:50 PM
Peterson Peterson is offline Windows 10 Office 2019
Competent Performer
 
Join Date: Jan 2017
Posts: 141
Peterson is on a distinguished road
Default

Try this:
Code:
Sub BulkFileRename() ' 05/13/2022


' This macro loops through all Word (.docx) and .rtf files in a user-selected
' folder. If a file contains a specified string, then the file is renamed, by
' removing the string. (Technically, a copy of the file is made with the new
' name, and the original is deleted.) If a file with that name already exists,
' then the old file is overwritten with the renamed file.
 
    Dim strToRemove As String, strPath As String, strNewName As String
    Dim objFile As File, objFolder As Folder
    Dim objFSO As Scripting.FileSystemObject
    
    ' String (case-sensitive) to remove from file names:
    strToRemove = "_Audited"
        
    ' Get the folder via function:
    strPath = fcnFolderPicker
    ' If the user didn't choose a folder, then exit sub:
    If strPath = "" Then
        Exit Sub
    End If
        
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFSO.GetFolder(strPath)
    
    ' Loop through all files in the folder:
    For Each objFile In objFSO.GetFolder(strPath).Files
        ' If the file has the string to be removed:
        If InStr(objFile.Name, strToRemove) <> 0 Then
            ' ...and the file is either a .docx or .rtf:
            If InStr(objFile.Name, ".docx") <> 0 Or InStr(objFile.Name, ".rtf") <> 0 Then
                ' ...then create a new file name by replacing the string to remove with nothing:
                strNewName = Replace(objFile.Name, strToRemove, "")
            End If
            
            ' Copy file with the string removed from the name; overwrite existing version, if necessary:
            objFSO.CopyFile objFolder.path & "\" & objFile.Name, objFolder.path & "\" & strNewName, True
            ' Delete the original file:
            objFSO.DeleteFile (objFile.path)
        End If
    Next objFile
End Sub

Function fcnFolderPicker() As String ' 05/13/2022

    Dim FolderPicker As FileDialog
    
    Set FolderPicker = Application.FileDialog(msoFileDialogFolderPicker)
       
    With FolderPicker
        .Title = "Choose the folder containing your files"
        .AllowMultiSelect = False
        ' If the user cancels, then exit function:
        If .Show <> -1 Then
            Exit Function
        Else
            fcnFolderPicker = .SelectedItems(1) & "\"
        End If
    End With
End Function
Reply With Quote