Change part of a file name using VBA

[VBANovices]

Hi I have multiple folders with files created by an employee Scott, he has subsequently left the firm and all the files he created have his name in them, so for example files are called FFC Notes - Germany - Scott.xlsx Each one is a country but I have hundreds of files he worked on could someone advise me of a way to loop through using VBA to other remove the Scott part or change it to something else like the company name. Grateful of some help - thank you

 

[DanteAmor]

Try this:
_________________________________________________________________________
Change these lines in the macro for your data

  sPath = "C:\trabajo\"   'Start folder
  sText = "Scott"         'Text to remove
  sNewt = ""              'Enter new text
    arch = Dir(sd & "\*.*")   'Change to "\*.xlsx" for only excel files

_________________________________________________________________________

Test the macro "Change_part_of_a_file" in a sample folder with sample files. Check if it is what you need.

Dim rutas As New Collection 'At the beginning of all the code

Sub Change_part_of_a_file()
  '
'DECLARATIONS
  Dim sPath As String, sText As String, sNewt As String, newName As String
  Dim arch As Variant, sd As Variant, ssd As String, n As Long
  '
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  '
'INPUT
  sPath = "C:\trabajo\"   'Start folder
  sText = "Scott"         'Text to remove
  sNewt = ""              'Enter new text
  Set rutas = Nothing
  rutas.Add sPath
  Call AddSubDir(sPath)
  '
'PROCESS
  For Each sd In rutas
    arch = Dir(sd & "\*.*")   'Change to "\*.xlsx" for only excel files
    Do While arch <> ""
      newName = ""
      If InStrRev(arch, " " & sText, , vbTextCompare) > 0 Then
        newName = Replace(arch, " " & sText, sNewt, , , vbTextCompare)
      ElseIf InStrRev(arch, sText, , vbTextCompare) > 0 Then
        newName = Replace(arch, sText, sNewt, , , vbTextCompare)
      End If
      If newName <> "" Then
        ssd = sd & IIf(Right(sd, 1) = "\", "", "\")
        Name ssd & arch As ssd & newName
        n = n + 1
      End If
      arch = Dir()
    Loop
  Next
'OUTPUT
  MsgBox "Updated files " & n
End Sub
'
Sub AddSubDir(lPath As Variant)
  Dim SubDir As New Collection, DirFile As Variant, sd As Variant
  If Right(lPath, 1) <> "\" Then lPath = lPath & "\"
  DirFile = Dir(lPath & "*", vbDirectory)
  Do While DirFile <> ""
    If DirFile <> "." And DirFile <> ".." Then _
      If ((GetAttr(lPath & DirFile) And vbDirectory) = 16) Then SubDir.Add lPath & DirFile
    DirFile = Dir
  Loop
  For Each sd In SubDir
    rutas.Add sd
    Call AddSubDir(sd)
  Next
End Sub

 

[VBANovices]

Genius, thank you ever so much really appreciate it.

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.