an Sepp

Sub test()
  Const cstrInitalPath As String = "C:\Users\a.mazza\Desktop\TEST UNZIP\"
  Const cstrSearch As String = "musicXML"
  Const cstrReplace As String = "1 Headlight"
   
  Call renameFilesAndFolders(cstrInitalPath, cstrSearch, cstrReplace)
End Sub
 
Sub renameFilesAndFolders(StartFolder As String, sSearch As String, sReplace As String)
  Dim objFSO As Object, objFolder As Object, objSFolder As Object, objFile As Object
  Dim strNewName As String
 
  Set objFSO = CreateObject("Scripting.FileSystemObject")
  Set objFolder = objFSO.GetFolder(StartFolder)
 
  For Each objSFolder In objFolder.SubFolders
    For Each objFile In objSFolder.Files
      If objFile.Name Like "*" & sSearch & "*" Then
        strNewName = objFile.ParentFolder.Path & "\" & Replace(objFile.Name, sSearch, sReplace)
        objFSO.MoveFile objFile.Path, strNewName
      End If
    Next
    If objSFolder.Name Like "*" & sSearch & "*" Then
      strNewName = objSFolder.ParentFolder.Path & "\" & Replace(objSFolder.Name, sSearch, sReplace)
      objFSO.MoveFolder objSFolder.Path, strNewName
    Else
      strNewName = objSFolder.Path
    End If
    Call renameFilesAndFolders(strNewName, sSearch, sReplace)
  Next
End Sub