Lister les caractéristiques des fichiers d'un répertoire

Peut-on faire pour lister dans un répertoire toutes les caractérisques des fichiers (dates, taille, extension...)

Ce code, à placer dans un module standard te permet de faire ce que tu souhaites

sub TousFichiersDunDossier()
 Dim FSO As Object, Dossier As Object, NomDossier
 Dim Files As Object, File As Object, i As Integer
 Dim Sh As Worksheet
 Dim EnTetes, ArrFSO
 
  Application.ScreenUpdating = False
  Set FSO = CreateObject("Scripting.FileSystemObject")
  'adapter le dossier racine si besoin
  NomDossier = ChoixDossierFichier("")
  If NomDossier = "" Then exit sub
  Set Dossier = FSO.GetFolder(NomDossier)
 
  Set Files = Dossier.Files
  If Files.Count <> 0 Then
   Set Sh = Sheets.Add
   EnTetes = Array("Chemin", "Nom", _
           "Date création", "Date dernière modification", _
           "Date dernier accès", "Taille", "Type", "Attribut(s)")
   'mise en forme
   With ActiveSheet.Range("A1:H1")
    .Value = EnTetes
    .Font.Bold = True
    .Interior.ColorIndex = 43
    .Borders.LineStyle = xlContinuous
    .HorizontalAlignment = xlCenter
   End With
   i = 1
   For Each File In Files
    i = i + 1
    With File
     ArrFSO = Array(.ParentFolder & "", .Name, .DateCreated, _
        .DateLastModified, .DateLastAccessed, .Size, .Type)
    End With
    Sh.Cells(i, 1). _
     Resize(1, UBound(ArrFSO) - LBound(ArrFSO) + 1).Value = ArrFSO
    Sh.Cells(i, UBound(ArrFSO) + 2).Value = Attributs(File.Attributes)
   Next
  End If
  Sh.UsedRange.EntireColumn.AutoFit
  Set FSO = Nothing: Set Sh = Nothing
  Set Dossier = Nothing: Set File = Nothing
 end sub
Function Attributs(Attrib)
 Dim Res$
  If Attrib = 0 Then Res = "Aucun attribut"
  If Attrib And 1 Then Res = Res & "/Lecture seule"
  If Attrib And 2 Then Res = Res & "/Caché"
  If Attrib And 4 Then Res = Res & "/Système"
  If Attrib And 32 Then Res = Res & "/Archive"
  Attributs = Res
 End Function
Function ChoixDossierFichier(Racine, Optional SelType As Byte = 0)
 Dim objShell, objFolder, Chemin, SecuriteSlash, FlagChoix&, Msg$
 
   If SelType = 0 Then
    FlagChoix = &H1&: Msg = "Choisissez un dossier :"
   Else
    FlagChoix = &H4000&: Msg = "Choisissez un fichier :"
   End If
 
   Set objShell = CreateObject("Shell.Application")
   'le troisième paramètre permet de choisir
   'la sélection d'un dossier ou d'un fichier (0 ou 1)
   'le dernier paramètre permet de choisir le dossier racine
   Set objFolder = objShell.BrowseForFolder(&H0&, Msg, FlagChoix, Racine)
   On Error Resume Next
   Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & ""
   If objFolder.Title = "Bureau" Then
     Chemin = "C:\Windows\Bureau"
   End If
   If objFolder.Title = "" Then
     Chemin = ""
   End If
 
   SecuriteSlash = InStr(objFolder.Title, ":")
 
   If SecuriteSlash > 0 Then
     Chemin = Mid(objFolder.Title, SecuriteSlash - 1, 2) & ""
   End If
   ChoixDossierFichier = Chemin
 End Function

Astuce illustrée par ce classeur
fs-listfichier

Auteur :

Mots clefs associés à cette page : , , , , ,