VBA - Extraction arborescence de dossier et informations fichiers

Bonjour,

Je suis actuellement en train d'effectuer une arborescence des dossiers de l'explorateur de fichier. J'aimerais faire ressortir le propriétaire et le dernier modificateur de chaque fichier à la suite des extractions déjà effetuées (nom, taille, chemin...) mais je ne trouve pas le mot clé.

Pouvez vous m'aider ? Je vous transmet le script :

Option Explicit
Dim oSheetD As Worksheet
Dim oSheetF As Worksheet
Dim sRacine As String
Dim Ligne1 As Long
Dim Ligne As Long
Dim NbFich As Long
Dim fs
Dim Fldracine
Dim oSFld
Dim oFich

Sub recupArbo()
'Préparation
Set oSheetD = Worksheets("Folders")
Set oSheetF = Worksheets("Files")
Application.ScreenUpdating = False
sRacine = ActiveWorkbook.Path
If sRacine = "" Then
  MsgBox "pour que la mise à jour puisse se faire, il faut enregistrer ce docuement dans un dossier valide"
  Exit Sub
End If

oSheetF.Activate
Range("A1").CurrentRegion.Clear
oSheetD.Activate
Ligne1 = 1
Ligne = Ligne1
NbFich = 1
Range("A" & Ligne1).CurrentRegion.Clear
'Mise en place du processus
Set fs = CreateObject("Scripting.FileSystemObject")
Set Fldracine = fs.getfolder(sRacine)
Lit_oFld Fldracine, 1

End Sub

Sub Lit_oFld(ByRef oFld, ByVal Niveau)
  oSheetD.Cells(Ligne, Niveau) = CStr(oFld.Name)
  oSheetD.Hyperlinks.Add anchor:=oSheetD.Cells(Ligne, Niveau), Address:=oFld.Path, TextToDisplay:=oFld.Name
  Application.StatusBar = NbFich & " - " & oFld.Name
  'Liste les fichiers
  For Each oFich In oFld.Files
    oSheetF.Cells(NbFich, 1) = oFich.Name
    oSheetF.Cells(NbFich, 2) = oFld.Path
    oSheetF.Cells(NbFich, 3) = oFich.Size
    oSheetF.Cells(NbFich, 4) = oFich.DateCreated
    oSheetF.Cells(NbFich, 5) = oFich.DateLastModified
    oSheetF.Hyperlinks.Add anchor:=oSheetF.Cells(NbFich, 1), Address:=oFld.Path & "\" & oFich.Name, TextToDisplay:=oFich.Name
    oSheetF.Hyperlinks.Add anchor:=oSheetF.Cells(NbFich, 2), Address:=oFld.Path, TextToDisplay:=oFld.Path
    NbFich = NbFich + 1
  Next
  '=====================================
  Ligne = Ligne + 1
  For Each oSFld In oFld.subfolders
    Lit_oFld oSFld, Niveau + 1
  Next

End Sub

Bonjour,

Il ne semble pas que la propriété dernier modificateur soit accessible de base. Vous pouvez lire ici Document Properties (cpearson.com) comment définir des fonctions permettant d'accéder à ces paramètres via un dll microsoft.

Edit : excusez moi, si vos fichiers sont de types Office il semble que la fonction https://learn.microsoft.com/en-us/office/vba/api/excel.workbook.builtindocumentproperties réponde à votre besoin.

Rechercher des sujets similaires à "vba extraction arborescence dossier informations fichiers"