XL 2016 Renommer un fichier commençant par

[lauradlmd]

Bonjour,

J'ai trouvé une macro pour enregistrer les PJ d'un mail outlook dans un dossier.
Maintenant je cherche à renommer mon fichier qui commencer par exemple par "Extraction - 14-10-22" par "Extraction".
Sauf qu'avec mon code il ne trouve pas mon fichier en utilisant le caractère "*"

Voilà mon code :
Dim AncienNom As String, NouveauNom As String

AncienNom = "I:\mondossier\Extraction" & "*.xlsx"
NouveauNom = "I:\mondossier\Extraction.xlsx"
Name AncienNom As NouveauNom

End Sub


Merci pour votre aide 🙂

 

[Dranreb]

Bonsoir
Non, mais un Dir vous le trouve si ce profil existe.

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

 

[AtTheOne]

Bonjour @lauradlmd, bonjour @Dranreb
Je viens de finir quelque chose que j'avais commencé hier et que je dû interrompre :
Cette Sub prend en compte les différents cas de figure :

• Il n'y a pas de fichier qui matche
• Il n'y a qu'un fichier qui matche
• Il y a plusieurs fichiers qui matchent (affichage d'un formulaire de choix)
• Un fichier "NouveauNom" existe déjà dans le répertoire de recherche

Pour simplifier la démo j'ai défini la variable contenant le répertoire à thisWorkBook.path (le répertoire du classeur contenant la macro) . C'est modifiable.

Le code du module mdl_AtTheOne

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

Le code du formulaire UsF_Choix associé

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

Voilà Bonne journée à tous et bon courage

 

[AtTheOne]

Re bonjour @Dranreb

ette Sub prend en compte les différents cas de figure :

• Il n'y a pas de fichier qui matche
• Il n'y a qu'un fichier qui matche
• Il y a plusieurs fichiers qui matchent (affichage d'un formulaire de choix)
• Un fichier "NouveauNom" existe déjà dans le répertoire de recherche

Tout comme toi, mais en plus long ...

Non, mais un Dir vous le trouve si ce profil existe.
VB:

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

Par contre je ne connais pas la dernière syntaxe Name AncienNom As NouveauNom, mais est-ce vraiment une syntaxe ou un raccourci pour simplifier l’écriture du message.

Amicalement
Alain

 

[Dranreb]

Bonjour.
C'est la même syntaxe que dans le code d'origine.
Si AncienNom et/ou NouveauNom ne comportent pas de chemin, CurDir est assumé, lequel est positionné par ChDrive suivi de ChDir.

 

[AtTheOne]

Re
Je ne connaissait pas je viens de trouvé dans l'aide :

Name, instruction​

Article

• 11/04/2022
• 2 minutes de lecture

Renomme un fichier, répertoire ou dossier de disque.

On en apprends tous les jours.

Merci

 

[lauradlmd]

Top merci pour vos réponses !!
Ca m'a été d'une grande aide moi qui ai galéré des heures hier soir...

 

[AtTheOne]

Bonjour @lauradlmd
Merci pour le retour,
Tu n'as plus qu'à marquer un des deux posts, le #2 ou le #3, comme solution (tu dois en choisir un seul)
Amicalement
Alain