Obtenir une date de modification de plusieurs fichiers
Résolu
Elodie
-
michel_m Messages postés 18903 Date d'inscription Statut Contributeur Dernière intervention -
michel_m Messages postés 18903 Date d'inscription Statut Contributeur Dernière intervention -
Bonjour à tous,
Voilà, étant nule sur Excel et en programmation, je vous pose cette question:
Je cherche à mettre dans un fichier excel les différentes dates de modification de plusieurs fichier d'un répertoire.
Exemple: A.doc modifié le 01/02/2015 à 12h15
B.doc modifié le 03/02/2015 à 08h12
C.doc modifié le 05/02/2015 à 09h45
J'aimerai que tous ces fichiers soit mis dans ce fichier Excel afin de voir la différence de traitement entre les fichiers. (Dans l'exemple il y en a 3 donc facile mais beaucoup moins quand je dois en faire 800).
Pouvez-vous m'aider?
Merci d'avance
NB: les fichiers sont dans le même dossier
Voilà, étant nule sur Excel et en programmation, je vous pose cette question:
Je cherche à mettre dans un fichier excel les différentes dates de modification de plusieurs fichier d'un répertoire.
Exemple: A.doc modifié le 01/02/2015 à 12h15
B.doc modifié le 03/02/2015 à 08h12
C.doc modifié le 05/02/2015 à 09h45
J'aimerai que tous ces fichiers soit mis dans ce fichier Excel afin de voir la différence de traitement entre les fichiers. (Dans l'exemple il y en a 3 donc facile mais beaucoup moins quand je dois en faire 800).
Pouvez-vous m'aider?
Merci d'avance
NB: les fichiers sont dans le même dossier
3 réponses
-
Et où sont tous ces fichiers ? dans le m^me dossier ?
-
Et voilà
La macro te propose une boite de dialogue te permettant de choisir ton dosiet
les fichiers listés sont des classeurs Excel
https://www.cjoint.com/?3BxsxxiQ7xe
ze code:Option Explicit
Dim Chemin As String
'-------
Function recherchedossier()
'Auteurs: @+thierry_xld et michel_m
Dim ObjShell As Object, ObjFolder As Object
Dim Message As String
Message = "Faire la Sélection du Repertoire de sauvegarde:"
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 & ""
If Chemin = "" Then End
recherchedossier = Chemin
End Function
'---------------------------------------------------
Sub dire_fichiers_date()
Dim Dico As Object
Dim Fich As String
'-----initialisations
Application.ScreenUpdating = False 'fige l'écran
Set Dico = CreateObject("scripting.dictionary")
'boite dialogue sélection dossier
recherchedossier
'rendre le dosiier actif
ChDir Chemin
'-----parcours
Fich = Dir("*.xls*")
While Fich <> ""
'mémorise le nom du fichier et la date de modif
If Not Dico.exists(Fich) Then Dico.Add Fich, FileDateTime(Fich)
Fich = Dir
Wend
'-------restitution
With ThisWorkbook.Sheets(1)
.Range("A2:B2000").Clear
.Range("A2").Resize(Dico.Count, 1) = Application.Transpose(Dico.Keys)
.Range("B2").Resize(Dico.Count, 1) = Application.Transpose(Dico.items)
.Range("A2:B" & Dico.Count + 1).Borders.Weight = xlThin
End With
End Sub
Enespérant que...
Tu dis
Michel-
C'est quasiement parfait!!!!
Quasiement car c'est des fichiers .doc(Word) que je voulais et pas des .xls (Excel). Et quand je lui donne le chemin d'accès, il me sort "Mes Documents".
En tout cas un très très grand merci déjà!!!
NB: En cherchant n peu à comprendre, j'ai pu modifier les fichiers Excel en fichiers word!!! (Je sais c'est pas un exploit mais je suis quand même contente!)
Dir("*.xls*") => Dir("*.doc*") -
Si tu ne travailles toujours que sur le m^me dossier
tu pourrais supprimer la fonction recherchedossier et écrire le chemin: gain de temps et pas de manipulation de la boite de dialogueSub dire_fichiers_date()
Dim Dico As Object
Dim Fich As String
'-----initialisations
Application.ScreenUpdating = False 'fige l'écran
Set Dico = CreateObject("scripting.dictionary")
'boite dialogue sélection dossier
recherchedossier
'rendre le dosiier actif
ChDir "C:\..... emplacement de ton dossier" -
-
-
Excuse moi, c'est une erreur de frappe de ma part =).
Le problème c'est que je n'ai pas le droit de modifier le dossier en question. Il me dit que j'ai pas les droits pour pouvoir le faire.
Sinon il y a pas un moyen comme avec les adresses internet de remplacer les espace par un code spécial?
Merciiiiiii =)
-
-
En fait j'ai exactement la même question qu'élodie mais je ne comprend pas comment faire ^^
-
Suite à ta demande en message personnel
ci dessous le code avec le chemin du dossier connu
les fichiers ayant un suffixe txt (je n'ai pas en t^te les autres suffixes possibles)
à adaper à ton contexteOption Explicit
'---------------------------------------------------
Sub dire_fichiers_date()
Dim Chemin As String
Dim Dico As Object
Dim Fich As String
'-----initialisations
Application.ScreenUpdating = False 'fige l'écran
Set Dico = CreateObject("scripting.dictionary")
'boite dialogue sélection dossier
recherchedossier
'rendre le dosiier actif
Chemin = "X:\Access\ Dossiers Archives\Archives" 'A ADAPTER A TON CONTEXTE
ChDir Chemin
'-----parcours
Fich = Dir("*.txt*") 'FICHIER SUFFIXE TXT
While Fich <> ""
'mémorise le nom du fichier et la date de modif
If Not Dico.exists(Fich) Then Dico.Add Fich, FileDateTime(Fich)
Fich = Dir
Wend
'-------restitution
With ThisWorkbook.Sheets(1)
.Range("A2:B2000").Clear
.Range("A2").Resize(Dico.Count, 1) = Application.Transpose(Dico.Keys)
.Range("B2").Resize(Dico.Count, 1) = Application.Transpose(Dico.items)
.Range("A2:B" & Dico.Count + 1).Borders.Weight = xlThin
End With
End Sub
-
