Récupérer le nom du propriétaire d’un fichier fermé

**hyperion13** · 22/09/2021, 06h04

Salut

Code :

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

1
2
3
4
5
6
7
8
Dim fso As New FileSystemObject, Chemin As String, fichier As File
 
Set fso = CreateObject("Scripting.FileSystemObject")
Chemin = CurrentProject.Path & "\"
Set fichier = fso.GetFile(Chemin & "Modele.csv")
    MsgBox "Date de création : " & fichier.DateCreated
    MsgBox "Date de la dernière mise à jour : " & fichier.DateLastModified
    MsgBox "Le dernier utilisateur est " & DernierCreateur(CurrentProject.Path & "\Modele.csv")

**Tnthi** · 22/09/2021, 09h32

Bonjour Hyperion13
Merci pour votre aide, mais ce code est affiche un message d'erreur, code incompatible avec la version, plateforme ou architecture de cette application...

**Jean-Philippe André** · 22/09/2021, 14h08

SAlut

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
Sub TaPatente()
MsgBox DernierCreateur("P:\Dossier\Fichier.csv")
End Sub
 
Public Function DernierCreateur(strPathComplet As String) As String
 
' Shell32 objects
Dim objShell As Shell32.Shell
Dim objFolder As Shell32.Folder
Dim objFolderItem As Shell32.FolderItem
 
' Other objects
Dim strPath As String
Dim strFileName As String
Dim i As Integer
    strPath = strPathComplet
    ' If the file does not exist then quit out
    If Dir(strPath) = "" Then Exit Function
 
    ' Parse the file name out from the folder path
    i = InStrRev(strPath, "\")
    strFileName = Mid$(strPath, i + 1)
    strPath = Left$(strPath, i - 1)
 
    ' Set up the shell32 Shell object
    Set objShell = New Shell
 
    ' Set the shell32 folder object
    Set objFolder = objShell.Namespace(strPath)
 
    ' If we can find the folder then ...
    If (Not objFolder Is Nothing) Then
 
        ' Set the shell32 file object
        Set objFolderItem = objFolder.ParseName(strFileName)
 
        ' If we can find the file then get the file attributes
        If (Not objFolderItem Is Nothing) Then
 
'            GetFileAttributes.Name = objFolder.GetDetailsOf(objFolderItem, 0)
'            GetFileAttributes.Size = objFolder.GetDetailsOf(objFolderItem, 1)
'            GetFileAttributes.FileType = objFolder.GetDetailsOf(objFolderItem, 2)
'            GetFileAttributes.DateModified = CDate(objFolder.GetDetailsOf(objFolderItem, 3))
'            GetFileAttributes.DateCreated = CDate(objFolder.GetDetailsOf(objFolderItem, 4))
'            GetFileAttributes.DateAccessed = CDate(objFolder.GetDetailsOf(objFolderItem, 5))
'            GetFileAttributes.Attributes = objFolder.GetDetailsOf(objFolderItem, 6)
'            GetFileAttributes.Status = objFolder.GetDetailsOf(objFolderItem, 7)
            DernierCreateur = objFolder.GetDetailsOf(objFolderItem, 10)
'            DernierCreateur = objFolder.GetDetailsOf(objFolderItem, 20)
'            GetFileAttributes.Title = objFolder.GetDetailsOf(objFolderItem, 21)
'            GetFileAttributes.Subject = objFolder.GetDetailsOf(objFolderItem, 22)
'            GetFileAttributes.Category = objFolder.GetDetailsOf(objFolderItem, 23)
 
        End If
 
        Set objFolderItem = Nothing
 
    End If
 
    Set objFolder = Nothing
    Set objShell = Nothing
 
 
End Function

**Tnthi** · 22/09/2021, 15h34

Merci Jean-Philippe
J'ai recopier ton code et adapter le chemin et fichier, mais rien à faire, le nom du propriétaire du fichier ne s'affiche toujours pas.
J'abandonne.

**tee_grandbois** · 22/09/2021, 15h46

bonjour,

J'ai recopiér ton code et adaptér le chemin et fichier, mais rien à faire, le nom du propriétaire du fichier ne s'affiche toujours pas.
J'abandonne.

le code posté par Jean-Philippe fonctionne (confirmé également par hyperion13) donc tu devrais montrer tes adaptations, le souci peut venir de là ... car si le fichier csv n'existe pas, il affichera une boite message vide

**hyperion13** · 22/09/2021, 16h03

Re,
Si j'ai bien compris le postulat Post#3, c'est bien à l'ouverture d'un classeur que tu souhaites visualiser les infos que tu demandes.
Donc :
Les références actives :
- Microsoft Scripting Runtime
- Microsoft Shell Controls Ans Automation
Dans le module ThisWorkBook

Code :

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

1
2
3
4
5
6
7
8
9
Private Sub Workbook_Open()
Dim fso As New FileSystemObject, Chemin As String, fichier As File
Set fso = CreateObject("Scripting.FileSystemObject")
Chemin = Application.ActiveWorkbook.Path & "\"
Set fichier = fso.GetFile(Chemin & "Modele.csv")
    MsgBox "Date de création : " & fichier.DateCreated
    MsgBox "Date de la dernière mise à jour : " & fichier.DateLastModified
    MsgBox "Le dernier utilisateur est " & DernierCreateur(Application.ActiveWorkbook.Path & "\Modele.csv")
End Sub

Dans un module standard, la fonction de Jean-Philippe André Post#4

**hyperion13** · 22/09/2021, 16h16

Salut,

Envoyé par tee_grandbois

bonjour,
le code posté par Jean-Philippe fonctionne (confirmé également par hyperion13) donc tu devrais montrer tes adaptations, le souci peut venir de là ... car si le fichier csv n'existe pas, il affichera une boite message vide

Si le fichier n'existait pas, ily aurait un runtime error 53 Fichier introuvable. A voir.

**Tnthi** · 22/09/2021, 17h18

Youpi!! le code de Jean-Philippe fonction en désactivant la ligne 'If Dir(strPath) = "" Then Exit Function
Merci infiniment Jean-Philippe
Comme quoi il ne faut jamais abandonner

Merci aussi à Hyperion13 et tee_grandbois

**tee_grandbois** · 22/09/2021, 17h21

bonjour hyperion13

Envoyé par hyperion13

Salut,

Si le fichier n'existait pas, ily aurait un runtime error 53 Fichier introuvable. A voir.

pas ave le code de Jean-Philippe, le Dir() à l'instruction 18 fait sortir de la fonction et n'empêche pas l'affichage du message dans la Sub TaPatente()

**tee_grandbois** · 22/09/2021, 17h24

Envoyé par Tnthi

Youpi!! le code de Jean-Philippe fonction en désactivant la ligne 'If Dir(strPath) = "" Then Exit Function
Merci infiniment Jean-Philippe
Comme quoi il ne faut jamais abandonner

Merci aussi à Hyperion13 et tee_grandbois

c'est étonnant que cela puisse fonctionner si le fichier n'existe pas ...

**hyperion13** · 22/09/2021, 17h41

Envoyé par tee_grandbois

bonjour hyperion13
pas ave le code de Jean-Philippe, le Dir() à l'instruction 18 fait sortir de la fonction et n'empêche pas l'affichage du message dans la Sub TaPatente()

Que nenni
En L18 j'ai bien

Code :

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