Rapatriement de la date de création fichier

Version imprimable

Bonjour à tous,
Petite problématique pour pouvoir rappatrier les dates de création de mes fichiers xls situé dans le répertoire blabla, vers mon fichier ouvert soit toto.xls colone 7, 8, 9 pour respectivement avoir, date de création, date de la dernière modification, date du dernier accès.

J'ai une erreur de synthaxe sur la déclaration de "fichier" je ne comprends pas vraiment pourquoi.
Pouvez vous m'aider?
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 Sub Chgt_donnees() Dim Compteur As Integer Dim Chemin_Rep As String Dim Objet_Fichier, Fichier Chemin_Rep = "moncheminwindows\blabla" Application.FileSearch.LookIn = Chemin_Rep Application.FileSearch.Filename = "*.xls" If Application.FileSearch.Execute > 0 Then For Compteur = 1 To Application.FileSearch.FoundFiles.Count Set Objet_Fichier = CreateObject("Scripting.FileSystemObject") Set Fichier = Objet_Fichier.GetFile(Application.FileSearch.Found Files(Compteur)) Worksheets("Feuil2").Select [A1].Offset(Compteur - 1, 7).Value = Fichier.DateCreated [A1].Offset(Compteur - 1, 8).Value = Fichier.DateLastModified [A1].Offset(Compteur - 1, 9).Value = Fichier.DateLastAccessed Next Compteur Else MsgBox "Pas de fichier disponible" End If End Sub
EDIT: Existe t-il la même fonction en formule excel classique? car il existe bien AUJOURDHUI() mais ça renvois la date du jour il faudrait un truc du genre:
DATECREATION(ANNEE();MOIS();JOUR()):aie:

03/08/2011, 12h12
kiki29

Salut; voir sur http://www.developpez.net/forums/d20...feuille-excel/

Bonjour
Une proposition
En plus tous tes fichiers en liens hypertextes
Ouvre un nouveau classeur Excel, mets ce code dans un module, enregistre ce fichier, puis fait Alt F8, exécute le code, pointe vers le répertoire de ton choix, tu auras tout...
Attention fait bien:
'Nécessite d'activer la référence "Microsoft Scripting RunTime"
'Dans l'éditeur de macros (Alt+F11):
'Menu Outils
'Références
'Cochez la ligne "Microsoft Scripting RunTime".
'Cliquez sur le bouton OK pour valider.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
Sub AppelRépertoire()
Dim Repert As FileDialog
Dim Chemin As String
 
Set Repert = Application.FileDialog(msoFileDialogFolderPicker)
Repert.Show
If Repert.SelectedItems.Count > 0 Then
    Chemin = Repert.SelectedItems(1)
    Set Repert = Nothing
    ListeFichiers Chemin
End If
 
End Sub
 
Sub ListeFichiers(Repertoire As String)
'Nécessite d'activer la référence "Microsoft Scripting RunTime"
        'Dans l'éditeur de macros (Alt+F11):
        'Menu Outils
        'Références
        'Cochez la ligne "Microsoft Scripting RunTime".
        'Cliquez sur le bouton OK pour valider.
Dim Fso As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder, SubFolder As Scripting.Folder
Dim FileItem As Scripting.File
Dim i As Long
 
Set Fso = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = Fso.GetFolder(Repertoire)
'Récupère le numéro de la dernière ligne vide dans la colonne A.
i = Range("A65536").End(xlUp).Row + 1
'Boucle sur tous les fichiers du répertoire
For Each FileItem In SourceFolder.Files
    'Inscrit le nom du fichier dans la cellule
    Cells(i, 1) = FileItem.Name
    'Ajoute un lien hypertexte vers le fichier
    ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 1), Address:=FileItem.ParentFolder & "\" & FileItem.Name
    'Indique la date de création
    Cells(i, 2) = FileItem.DateCreated
    'Indique la date de dernier acces
    Cells(i, 3) = FileItem.DateLastAccessed
    'Indique la date de dernière modification
    Cells(i, 4) = FileItem.DateLastModified
    'Nom du répertoire
    Cells(i, 5) = FileItem.ParentFolder
    i = i + 1
Next FileItem
Columns("A:D").AutoFit
'--- Appel récursif pour lister les fichier dans les sous-répertoires ---.
For Each SubFolder In SourceFolder.subfolders
    ListeFichiers SubFolder.Path
Next SubFolder
Set Fso = Nothing
Set SourceFolder = Nothing
End Sub

Alors voilà ce que j'ai fait, en partant sur le 1er code

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
Sub ListFilesInFolder(strFolderName As String)
 
  ' necessite d'activer la reference Microsoft Scripting RunTime
  Static FSO As FileSystemObject
  Dim openSourceFolder As Scripting.Folder
  Dim openFile As Scripting.File
  Dim FLe As Worksheet
  Dim iRow As Long
 
  Set CLe = Workbooks("Statistiques.xls")
  Set FLe = CLe.Worksheets("Feuil2")
  Set FSO = CreateObject("Scripting.FileSystemObject")
 
  iRow = 2
  Set openSourceFolder = FSO.GetFolder(strFolderName)
  For Each openFile In openSourceFolder.Files
 
    FLe.Cells(iRow, 7) = openFile.DateCreated
    FLe.Cells(iRow, 8) = openFile.DateLastModified
    FLe.Cells(iRow, 9) = openFile.DateLastAccessed
 
    iRow = iRow + 1
  Next openFile
 
    Columns("G:I").Select
    Selection.NumberFormat = "m/d/yyyy"
 
End Sub
 
Private Sub test()
  ListFilesInFolder "W:\monchemin\"
End Sub

Peux être que ma question est passé inaperçu mais peut ton faire avec des formules excel afficher la date de création du fichier dans une cellule?

Du genre:
DATECREATION(ANNEE();MOIS();JOUR())

04/08/2011, 14h03
SfJ5Rpw8

mais sans Fso ... :

http://excel.developpez.com/faq/inde...#LirePropriete