Renommer tous les fichiers d'un répertoire passés en revue par date de création

[BenHarber]

Bonsoir le Forum,
Je souhaite renommer tous les fichiers .pdf d'un répertoire.
J'ai trouvé sur le net une macro qui comprend la commande suivante :
nomFich = Dir(Chemin & "*.pdf")
L'ennui c'est que cette commande semble passer en revue tous les fichiers .pdf du répertoire par ordre alphabétique. Or, je souhaiterais les passer en revue par ordre chronologique de date de création.

Savez-vous si c'est possible ?

Merci d'avance pour vos idées et suggestions souvent salvatrices !

BH

 

[tototiti2008]

Re : Renommer tous les fichiers d'un répertoire passés en revue par date de création

Bonjour BenHarper,

Or, je souhaiterais les passer en revue par ordre chronologique de date de création

Les passer en revue où ? FileSystemObject devrait te permettre de lire la date de création, si tu les mets dans la feuille de calcul tu pourra les trier grâce à Excel, si ça reste en mémoire il faudra passer par un tableau VBA et envisager un tri de celui-ci en VBA

Edit : d'autre part si tu veux tous les renommer, pourquoi un ordre particulier ?

 

[job75]

Re : Renommer tous les fichiers d'un répertoire passés en revue par date de création

Bonjour BenHarber, Marc,

J'ai fait le boulot, voyez le fichier joint.

Les deux boutons permettent de renommer les fichiers :

- soit avec leur date/heure de création, c'est le plus simple

- soit avec un numéro d'ordre, c'est nettement plus compliqué, il faut trier la liste des fichiers et renommer 2 fois.

Avec la macro Quick sort aucune restitution dans la feuille de calcul n'est nécessaire.

A+

 

[BenHarber]

Re : Renommer tous les fichiers d'un répertoire passés en revue par date de création

Bonjour Marc, Job75,
Désolé de répondre aussi tardivement, emporté dans d'autres projets, tous plus importants les uns que les autres...

Job75, merci beaucoup pour ce travail perlé...auquel, je l'avoue, je ne comprends pas grand chose !!
(mais bon : je ne séjourne en "VBAtrie" que quelques jours par an, alors que vous semblez y habiter continuellement !)

Néanmoins les 2 macros plantent, au second passage de la boucle suivante :
For n = 1 to Ubound(a)
J'ai le message suivant : "Erreur d'exécution '58' : Ce fichier existe déjà".

Du coup, je me demande si cela ne vient pas du fait que plusieurs de mes fichiers .pdf ont la même date de création : tous mes fichiers sont issus d'un publipostage Word avec une date de création identique (rythme = 18 fichiers par secondes).

Si c'est ça, il faudrait travailler avec une date de création au centièmes de secondes mais je crois que ce n'est pas possible, non ?

En tout cas, encore félicitation pour ce beau travail de programmation !

BH

 

[job75]

Re : Renommer tous les fichiers d'un répertoire passés en revue par date de création

Bonjour BenHarber,

Du coup, je me demande si cela ne vient pas du fait que plusieurs de mes fichiers .pdf ont la même date de création : tous mes fichiers sont issus d'un publipostage Word avec une date de création identique (rythme = 18 fichiers par secondes).

Eh oui c'est ça, je ne pensais pas que des fichiers puissent avoir la même date/heure de création.

Mais cela ne pose pas de problème, il suffit de ne pas renommer les fichiers avec la date/heure de création.

Pour les renommer avec un numéro d'ordre il faut les renommer provisoirement avec un numéro d'ordre formaté différemment :

Sub Renommer_avec_numero_ordre()
Dim dossier$, nom$, extension$, liste$(), a, b, n&, t$
dossier = ThisWorkbook.Path & "\MesPDF\" 'à adapter
nom = "FichierPDF " 'à adapter
extension = ".pdf"
'---liste des noms complets et des dates/heures de création---
liste = ListeFichiers(dossier, extension)
If liste(0, 0) = "" Then Exit Sub
a = Application.Index(liste, 2, 0) 'date/heure de création
b = Application.Index(liste, 1, 0) 'nom complet
tri a, b, 1, UBound(a) 'tri sur date/heure de création
'---renomme les fichiers---
For n = 1 To UBound(a) 'renomme provisoirement
  Name b(n) As dossier & Format(n, "00000000") & extension
Next
For n = 1 To UBound(a) 'renomme définitivement
  t = dossier & Format(n, "00000000") & extension
  Name t As dossier & nom & Format(n, "0000") & extension
Next
End Sub

Fichier (2).

A+

 

[job75]

Re : Renommer tous les fichiers d'un répertoire passés en revue par date de création

Re,

J'ai vérifié : la date/heure renvoyée par DateCreated ne contient pas de fractions de secondes.

Pour finir, avec ce code on restitue les données dans la feuille de calcul :

Sub Renommer_avec_numero_ordre()
Dim dossier$, nom$, extension$, liste$(), a, b, n&, t$
dossier = ThisWorkbook.Path & "\MesPDF\" 'à adapter
nom = "FichierPDF " 'à adapter
extension = ".pdf"
Application.ScreenUpdating = False
Range("A2:B" & Rows.Count).Delete xlUp 'RAZ
'---liste des noms complets et des dates/heures de création---
liste = ListeFichiers(dossier, extension)
If liste(0, 0) = "" Then Exit Sub
a = Application.Index(liste, 2, 0) 'date/heure de création
b = Application.Index(liste, 1, 0) 'nom complet
tri a, b, 1, UBound(a) 'tri sur date/heure de création
'---renomme les fichiers---
For n = 1 To UBound(a) 'renomme provisoirement
  Name b(n) As dossier & Format(n, "00000000") & extension
Next
For n = 1 To UBound(a) 'renomme définitivement
  t = dossier & Format(n, "00000000") & extension
  b(n) = nom & Format(n, "0000") & extension
  Name t As dossier & b(n)
Next
'---restitution dans la feuille--
[A2].Resize(n - 1) = Application.Transpose(b)
[B2].Resize(n - 1) = Application.Transpose(a)
End Sub

Fichier (3).

A+

 

[job75]

Re : Renommer tous les fichiers d'un répertoire passés en revue par date de création

Re,

Pas tout à fait fini.

Si l'on veut de vraies dates/heures (nombres) en colonne B :

- le tableau liste() doit être de type Variant, de même que a() dans la fonction

- dans la fonction la 2ème ligne est définie par a(1, n) = CDbl(CDate(f.DateCreated))

ce qui permet de faire le tri sur des nombres.

Fichier (4).

A+




A+

 

[BenHarber]

Re : Renommer tous les fichiers d'un répertoire passés en revue par date de création

Ouïe ouïe ouïe : ma pauvre tête risque d'imploser...

Je vais regarder ça tranquillement, et vous tiens au courant de mes essais, promis !...même si ce n'est pas dans dans les 3 jours...
En tout cas Job75, 1000 mercis pour ce travail perlé que je vais certainement étendre à d'autres cas pratiques !

Bien cordialement,
BenHarber