XL 2016 Renommer un fichier commençant par

ChDrive "I": ChDir "I:\mondossier"
AncienNom = Dir("Extraction*.xlsx")
If AncienNom = "" Then Exit Sub
NouveauNom = "Extraction.xlsx"
If NouveauNom = AncienNom Then Exit Sub
If Dir(NouveauNom) <> "" Then Exit Sub
Name AncienNom As NouveauNom

Public NomFi$
Sub RenommerFi()

'IDENTIFICATION DU FICHIER DANS DES CONSTANTES
'(On pourrait lire ces trois données dans des cellules ou les passer en variables)
     Const Préfixe$ = "Extraction"
     Const Suffixe$ = ".txt"
     Const NouveauNom$ = "Extraction.txt"
    
     Dim Chemin$, Masque$, FiTrouvé$, LiFi$, Tb, NbFi As Integer
     'Système de fichiers
     Dim FSO As Object
     Set FSO = CreateObject("Scripting.FileSystemObject")
    
     'Initialisations
     'Chemin de la recherche
     Chemin = ThisWorkbook.Path & "\"
     'Masque pour la recherche
     Masque$ = Chemin & Préfixe & "*" & Suffixe
     LiFi = "":  NomFi = ""
    
     'Vérifier si un fichier portant le nouveau nom n'existe pas dans le répertoire
     If FSO.fileexists(Chemin & NouveauNom) Then
         MsgBox "un fichier nommé :" & Chr(10) & Chr(9) & NouveauNom & Chr(10) & "existe déjà dans le répertoire :" & Chr(10) & Chr(9) & Chemin & Chr(10) & Chr(10) & "Fin de la procédure"
         Exit Sub
     End If
    
     'Recherche des fichiers correspondant au masque
     FiTrouvé = Dir(Masque)
     NomFi = FiTrouvé
     While FiTrouvé <> ""
          'Ajouté le fichier trouvé à la liste
          LiFi = LiFi & Chr(10) & FSO.GetFile(Chemin & NomFi).Name
          'Rechercher le fichier suivant correspondant au Masque
          FiTrouvé = Dir()
     Wend
    
     'Supprimer le premier élément vide
     LiFi = Replace(LiFi, Chr(10), "", 1, 1)
     'Récupérer tous les élément dans un tableau
     Tb = Split(LiFi, Chr(10))
     'Nombre de fichiers trouvés
     NbFi = UBound(Tb) + 1
    
     If NbFi = 1 Then
          'Cas d'un seul fichier trouvé
          NomFi = NomFi
     Else
          'Cas avec plusieurs fichiers trouvé
          'On affiche un Formulaire pour Choisir le fichier à renommer
          With UsF_Choix
               'Liste des fichiers dans la ComboBox
               .CBx_Choix.List = Tb
               'Adaptation de la taille et des positions des contrôles en fonction du nombre de fichiers trouvés
               If NbFi > 10 Then NbFi = 10 'limiter pour une hauteur de 10 fichiers
               Augm = 11 * NbFi
               .Height = 110 + Augm
               .CBn_Annuler.Top = 55 + Augm
               .CBn_Valider.Top = 55 + Augm
               .Lbl_Confirmation.Top = 59 + Augm
               .CBx_Choix.ListRows = NbFi
               'Affichage du formulaire
               .Show
          End With
     End If
              

     If NomFi <> "" Then
          'Renommer le fichier
          FSO.GetFile(Chemin & NomFi).Name = NouveauNom
          MsgBox "Le fichier a été renommé"
     End If
     Set FSO = Nothing
    
End Sub

Private Sub CBn_Annuler_Click()
     NomFi = ""
     Me.Hide
End Sub

Private Sub CBn_Valider_Click()
     NomFi = Me.CBx_Choix.Value
     Me.Hide
End Sub

Private Sub CBx_Choix_Change()
     If Me.CBx_Choix <> "" Then
          Me.Lbl_Confirmation.TextAlign = fmTextAlignRight
          Me.Lbl_Confirmation.Font.Bold = True
          Question = "Renommer le fichier """ & Me.CBx_Choix.Value & """ ? "
          Me.CBn_Valider.Visible = True
     Else
          Me.Lbl_Confirmation.TextAlign = fmTextAlignLeft
          Me.Lbl_Confirmation.Font.Bold = False
          Question = "Choisir un fichier"
          Me.CBn_Valider.Visible = False
     End If
     Me.Lbl_Confirmation.Caption = Question
End Sub

Private Sub UserForm_Activate()
     Me.CBx_Choix.DropDown
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
     If CloseMode = vbFormControlMenu Then
          MsgBox "Utiliser le bouton ""Annuler"" ou ""Valider"" pour sortir !"
     End If
End Sub