Discussion :

[stdonat]

Bonjour
Je cherche à connaitre le nom du dernier utilisateur d’un fichier.
Grace a ce forum j’ai réussi à « balayer » une arborescence afin dans lister les caractéristiques des fichiers.
Avec File Item j’obtiens ainsi les dates des dernières modifications mais pas le nom du dernier utilisateur.

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
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
    Dim SubFolder As Scripting.Folder
    Dim FileItem As Scripting.File
    Dim i As Long
 
    'Dim F As Scripting.FileSystemObject, FS As Scripting.FileSystemObject
    'Set FS = CreateObject("Scripting.FileSystemObject")
 
    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 + 2
 
    '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
        'Indique la taille du fichier
        Cells(i, 5) = FileItem.Size
        'Indique le nom du dernier utilisateur
        'Set F = FS.GetFile(FileItem.ParentFolder & "\" & FileItem.Name)
        'Cells(i, 6) = MonFichier.BuiltinDocumentProperties("Last Author").Value
        'Nom du répertoire
        Cells(i, 7) = FileItem.ParentFolder
        'Ajoute un lien hypertexte vers le repertoire
        ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 6), _
            Address:=FileItem.ParentFolder '& "\" & FileItem.Name
 
        i = i + 1
    Next FileItem
 
 
    '--- Appel récursif pour lister les fichier dans les sous-répertoires ---.
    For Each SubFolder In SourceFolder.SubFolders
        ListeFichiers SubFolder.Path
    Next SubFolder
 
End Sub

Normalement ont doit pouvoir le récupérer via

Code :

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

MonFichier.BuiltinDocumentProperties("Last Author").Value

Mais il me semble que pour cela il est nécessaire d’ouvrir le fichier qui n’est pas forcément un fichier Excel….

Comment puis-je récupérer ce nom de dernier Utilisateur ?

[eriiic]

Bonjour,

il s'agit d'une propriété propre aux fichiers MS Office que tu ne trouves pas sur n'importe quel fichier.
De mémoire, NTFS ne stocke que la date du dernier accès, pas l'identifiant de l'auteur.
eric

[stdonat]

Ok merci pour cette info mais est il possible d'avoir le nom pour un fichier Excel ?

[Menhir]

Je pense que ça doit être caché dans les ContentTypeProperties du Workbook.
Mais je n'ai pas trop le temps d'y fouiller.
Tu peux commencer ta recherche ici : https://msdn.microsoft.com/fr-fr/vba...property-excel

[kiki29]

Salut, voir par ici ? En tenant compte de la remarque faite en bas de ce post.

[MarcelG]

Bonjour à tous,

(Excuses KIKI, post télescopés)

En activant la Référence

Microsoft Shell Controls and Automation

ch_list est le nom de la cellule où figure le nom du répertoire à lister

Code :

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

1
2
3
4
5
6
Public Sub liste()
Dim t as Single
t = Timer
Call liste_dossiers(Worksheets("Liste_App").[ch_list])
Debug.Print (Timer - t) / 60 & " minutes"
End Sub

Procédure avec pour argument le nom du répertoire

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
Public Sub liste_dossiers(racine As String)
 
'0    Nom
'1    Taille
'2    Type d'élément
'3    Date de modification
'4    Date de création
'5    Date d'accès
'6    Attributs
'7    État hors connexion
'8    Hors connexion
'9    Type identifié
'10  Propriétaire = Gestionnaire dernier enregistrement
'11  Sorte
'12  Prise de vue
'13  Artistes ayant participé
'14  Album
'15  Année
'16  Genre
'17  Chefs d'orchestre
'18  Mots -clés
'19  Notation
'20  Auteurs = créateur du fichier
'21  Titre
'22  Objet
'23  Catégories
'24  Commentaires
'25  Copyright
'26  N°
'27  Longueur
'28  Vitesse de transmission
'29  Protégé
'30  Modèle d 'appareil photo
'31  Dimensions
'32  Appareil photo
'33  Entreprise
'34  Description du fichier
'35  Nom du programme
'36  Durée
'37  Connecté
'38  Périodique
'39  Emplacement
'40  Adresses des participants facultatifs
'... jusqu'à 60 et +?
 
   Application.ScreenUpdating = False
 
   Worksheets("Liste_App").Range("A2:D5000").ClearContents
 
    Dim objShell As Shell32.Shell
    Dim nomfich As Shell32.FolderItem
    Dim lerép As Shell32.Folder
 
    Set objShell = CreateObject("Shell.Application")
    'Répertoire cible
    Set lerép = objShell.Namespace(racine)
 
    Dim Ligne As Integer
    Ligne = 2
 
    'boucle sur tous les elements du repertoire
    For Each nomfich In lerép.Items
 
        With Worksheets("Liste_App")
 
            'caractéristique : pour auteur i = 20
            'Nom du fichier
            .Range("A" & Ligne).Value = lerép.GetDetailsOf(nomfich, 0)
 
            'Date de création
            .Range("B" & Ligne).Value = lerép.GetDetailsOf(nomfich, 4)
 
            'Date de modification
            Range("C" & Ligne).Value = lerép.GetDetailsOf(nomfich, 3)
 
            'Intervenant ayant effectué le dernier enregistrement
            .Range("D" & Ligne).Value = lerép.GetDetailsOf(nomfich, 10)
 
        End With
 
        Ligne = Ligne + 1 'pour séparer les blocs
 
    Next
 
End Sub

[stdonat]

Merci à Tous
Super ca marche