Discussion :

[MarcelG]

Bonjour le Forum,

J'aurais souhaité connaître les auteurs (identifiants) de tous les fichiers Excel appartenant à un dossier.

Néophyte en la matière, j'utilise la méthode FSO

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
Option Explicit
Dim wk_Info As Worksheet
 
Private Sub test()
       Set wk_Info = ActiveSheet
        Lister_Fichiers "lerépertoire", True
        Set wk_Info = Nothing
End Sub
 
Sub Lister_Fichiers(Mon_Répertore As String, Est_Inclus_Ss_Répertoires As Boolean)
 
' adapté de Ole P Erlandsen
' necessite d'activer la reference Microsoft Scripting RunTime
 
Static FSO As FileSystemObject
Dim Rép_Principal As Scripting.Folder
Dim Sous_Rép As Scripting.Folder
Dim Fichier As Scripting.File
 
Static La_Ligne As Long
Static EstLigne1 As Boolean
 
If Not EstLigne1 Then
 
        Set FSO = CreateObject("Scripting.FileSystemObject")
 
        With wk_Info
 
                .Cells(1, 1) = "Parent folder"
                .Cells(1, 2) = "Full path"
                .Cells(1, 3) = "File name"
                .Cells(1, 4) = "Size"
                .Cells(1, 5) = "Type"
                .Cells(1, 6) = "Date created"
                .Cells(1, 7) = "Date last modified"
                .Cells(1, 8) = "Date last accessed"
                .Cells(1, 9) = "Attributes"
                .Cells(1, 10) = "Short path"
                .Cells(1, 11) = "Short name"
                .Cells(1, 12) = "Author"
 
 
        End With
 
        La_Ligne = 2
        EstLigne1 = True
 
End If
 
Set Rép_Principal = FSO.GetFolder(Mon_Répertore)
 
For Each Fichier In Rép_Principal.Files
 
        With wk_Info
                .Cells(La_Ligne, 1) = Fichier.ParentFolder.Path
                .Cells(La_Ligne, 2) = Fichier.Path
                .Cells(La_Ligne, 3) = Fichier.Name
                .Cells(La_Ligne, 4) = Fichier.Size
                .Cells(La_Ligne, 5) = Fichier.Type
                .Cells(La_Ligne, 6) = Fichier.DateCreated
                .Cells(La_Ligne, 7) = Fichier.DateLastModified
                .Cells(La_Ligne, 8) = Fichier.DateLastAccessed
                .Cells(La_Ligne, 9) = Fichier.Attributes
                .Cells(La_Ligne, 10) = Fichier.ShortPath
                .Cells(La_Ligne, 11) = Fichier.ShortName
        End With
 
        La_Ligne = La_Ligne + 1
 
Next Fichier
 
For Each Sous_Rép In Rép_Principal.SubFolders
' On peut mettre ici un traitement spécifique pour les dossiers
Next Sous_Rép
 
If Est_Inclus_Ss_Répertoires Then
        For Each Sous_Rép In Rép_Principal.SubFolders
                Lister_Fichiers Sous_Rép.Path, True
        Next Sous_Rép
End If
 
Set Rép_Principal = Nothing
Set FSO = Nothing
 
End Sub

Le problème est que l'on ne peut pas affecter à l'objet ici "Fichier" la propriété "Author"

J'ai aussi pensé à la méthode

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

BuiltinDocumentProperties

mais, sauf erreur, celle-ci s'applique sur un classeur actif.

Enfin, je ne peux pas installer la librairie DSO sur mon poste

Comment donc lister des fichiers avec cette propriété "Auteur"

Merci par avance.

[parmi]

Bonjour,

Dans ce bout de code il y a 40 propriétés inscrites dont Auteur (index 20)
Je n'ai pas inclus la récursivité ni la vérification si fichiers Excel ou non, mais je pense que tu sais où tu vas de ce côté-là...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub Test()
    Dim I As Long, Ligne As Long
    Dim sFile As Variant
    Dim oShell: Set oShell = CreateObject("Shell.Application")
    Dim oDir:   Set oDir = oShell.Namespace("Chemin des fichiers")
 
    Ligne = 2
 
    For Each sFile In oDir.Items
        For I = 0 To 40
            Range("A" & Ligne) = I
            Range("B" & Ligne) = oDir.GetDetailsOf(oDir.Items, I)
            Range("C" & Ligne) = oDir.GetDetailsOf(sFile, I)
            Ligne = Ligne + 1
        Next
        Ligne = Ligne + 1 'pour séparer les blocs
    Next
End Sub

[MarcelG]

Bonjour le Forum,

Bonjour Parmi et merci pour ta réponse.

Ton code est efficace et répond à ma demande.