Renommer des fichiers en utilisant Excel

Function recherchedossier()  
'Auteurs: @+thierry_xld et michel_m  
Dim ObjShell As Object, ObjFolder As Object  
Dim Message As String  
Dim Chemin As String  
      
Message = "Faire la Sélection du Repertoire des fichiers .mxf"  

Set ObjShell = CreateObject("Shell.Application")  
Set ObjFolder = ObjShell.BrowseForFolder(&H0&, Message, 1)  
      
    On Error Resume Next 'Si on sort sans sélection  
    Chemin = ObjFolder.ParentFolder.ParseName(ObjFolder.Title).Path & ""  
    recherchedossier = Chemin  
End Function  


Sub renommer()  
Dim dico As Object, nouveau As String, ancien As String  
Dim derlig As Integer, lig As Integer  
Dim fich As String  
'creation d'une association ancien et nouveau nom  
derlig = Cells(Cells.Rows.Count, "A").End(xlUp).Row  
Set dico = CreateObject("scripting.dictionary")  
For lig = 2 To derlig  
     ancien = Trim(Cells(lig, 1)) & ".mxf"  
     nouveau = Trim(Cells(lig, 4)) & ".mxf"  
     If Not dico.exists(ancien) Then  
          dico.Add ancien, nouveau  
     End If  
Next  
ChDir recherchedossier  
fich = Dir("*.mxf")  
'boucle sur les fichiers suffixe mxf  
While fich <> ""  
     If dico.exists(fich) Then  
          'renomme avec nouveau nom  
          Name fich As dico(fich)  
     End If  
     fich = Dir  
Wend  
Msgbox "fichiers avec le suffixe .mxf renommés dans le dossier " & recherchedossier
End Sub