Lister les caractéristiques des fichiers d'un répertoire
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 subFunction 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 FunctionAstuce illustrée par ce classeur
fs-listfichier
Auteur : Frédéric Sigonneau
Mots clefs associés à cette page : caractéristique, dossier, fichier, classeur, file, xls
- Vous devez vous identifier ou créer un compte pour écrire des commentaires
