Droit d'acces sur fichier

[pobrouwers]

Bonjour le forum,

Je souhaiterais connaître les droits d'acces sur des fichiers qui sont stockés sur un serveur dans différents sous répertoires. Tous les fichiers commencent par LE.
Donc avoir pour chaque fichier la liste des utilisateurs qui ont acces en lecture et/ou en ecriture.
D'avance merci.
Bon dimanche...

 

[MichelXld]

bonjour cher Pobrouwers

l'exemple ci dessous est adapté de ce lien

Ce lien n'existe plus



Sub listerAutorisationsFichier()
'
'http://www.labo-microsoft.com/scripts/16024/
'
'adapté et testé avec Excel 2002 & WinXP
'
Dim strFileName As String
Dim objWMIService As Object, objFileSecuritySettings As Object
Dim objACE ' As ?????
Dim objSD ' As ?????
Dim intRetVal As Long
Dim intControlFlags As Long
Dim arrACEs ' As ?????

strFileName = 'C:\\\\\\\\Documents and Settings\\\\\\\\michel\\\\\\\\leClasseur.xls'

Const SE_DACL_PRESENT = &H4
Const ACCESS_ALLOWED_ACE_TYPE = &H0
Const ACCESS_DENIED_ACE_TYPE = &H1
Const FILE_ALL_ACCESS = &H1F01FF
Const FILE_APPEND_DATA = &H4
Const FILE_DELETE = &H10000
Const FILE_DELETE_CHILD = &H40
Const FILE_EXECUTE = &H20
Const FILE_READ_ATTRIBUTES = &H80
Const FILE_READ_CONTROL = &H20000
Const FILE_READ_DATA = &H1
Const FILE_READ_EA = &H8
Const FILE_SYNCHRONIZE = &H100000
Const FILE_WRITE_ATTRIBUTES = &H100
Const FILE_WRITE_DAC = &H40000
Const FILE_WRITE_DATA = &H2
Const FILE_WRITE_EA = &H10
Const FILE_WRITE_OWNER = &H80000

Set objWMIService = GetObject('winmgmts:')
Set objFileSecuritySettings = _
objWMIService.Get('Win32_LogicalFileSecuritySetting='' & strFileName & ''')

intRetVal = objFileSecuritySettings.GetSecurityDescriptor(objSD)
intControlFlags = objSD.ControlFlags

If intControlFlags And SE_DACL_PRESENT Then
arrACEs = objSD.DACL

For Each objACE In arrACEs

Debug.Print objACE.Trustee.Domain & '\\\\\\\\' & objACE.Trustee.Name

If objACE.AceType = ACCESS_ALLOWED_ACE_TYPE Then
Debug.Print vbTab & 'Allowed:'
ElseIf objACE.AceType = ACCESS_DENIED_ACE_TYPE Then
Debug.Print vbTab & 'Denied:'
End If

If objACE.AccessMask And FILE_ALL_ACCESS Then
Debug.Print vbTab & vbTab & 'FILE_ALL_ACCESS '
End If

If objACE.AccessMask And FILE_APPEND_DATA Then
Debug.Print vbTab & vbTab & 'FILE_APPEND_DATA '
End If

If objACE.AccessMask And FILE_DELETE Then
Debug.Print vbTab & vbTab & 'FILE_DELETE '
End If

If objACE.AccessMask And FILE_DELETE_CHILD Then
Debug.Print vbTab & vbTab & 'FILE_DELETE_CHILD '
End If

If objACE.AccessMask And FILE_EXECUTE Then
Debug.Print vbTab & vbTab & 'FILE_EXECUTE '
End If

If objACE.AccessMask And FILE_READ_ATTRIBUTES Then
Debug.Print vbTab & vbTab & 'FILE_READ_ATTRIBUTES '
End If

If objACE.AccessMask And FILE_READ_CONTROL Then
Debug.Print vbTab & vbTab & 'FILE_READ_CONTROL '
End If

If objACE.AccessMask And FILE_READ_DATA Then
Debug.Print vbTab & vbTab & 'FILE_READ_DATA '
End If

If objACE.AccessMask And FILE_READ_EA Then
Debug.Print vbTab & vbTab & 'FILE_READ_EA '
End If

If objACE.AccessMask And FILE_SYNCHRONIZE Then
Debug.Print vbTab & vbTab & 'FILE_SYNCHRONIZE '
End If

If objACE.AccessMask And FILE_WRITE_ATTRIBUTES Then
Debug.Print vbTab & vbTab & 'FILE_WRITE_ATTRIBUTES '
End If

If objACE.AccessMask And FILE_WRITE_DAC Then
Debug.Print vbTab & vbTab & 'FILE_WRITE_DAC '
End If

If objACE.AccessMask And FILE_WRITE_DATA Then
Debug.Print vbTab & vbTab & 'FILE_WRITE_DATA '
End If

If objACE.AccessMask And FILE_WRITE_EA Then
Debug.Print vbTab & vbTab & 'FILE_WRITE_EA '
End If

If objACE.AccessMask And FILE_WRITE_OWNER Then
Debug.Print vbTab & vbTab & 'FILE_WRITE_OWNER '
End If

Next

Else
Debug.Print 'No DACL present in security descriptor'
End If

End Sub


bon apres midi
MichelXld

 

[pobrouwers]

Michel,

Merci pour ta réponse rapide mais je viens de tester en changeant évidemment le chemin d'acces mais lorsque j'exécute la macro rien de ne se passe...

J'ai testé sur excel 2000 et 2003 avec win xp

Quel est le résultat en fait ?

As-tu idée ?

Merci

 

[MichelXld]

rebonjour Pobrouwers

le résultat s'affiche dans la fenetre d'execution de l'editeur de macros

Menu Affichage
Fenetre d'execution



un exemple de resultat (en local)

MIMI\\michel
Allowed:
FILE_ALL_ACCESS
FILE_APPEND_DATA
FILE_DELETE
FILE_DELETE_CHILD
FILE_EXECUTE
FILE_READ_ATTRIBUTES
FILE_READ_CONTROL
FILE_READ_DATA
FILE_READ_EA
FILE_SYNCHRONIZE
FILE_WRITE_ATTRIBUTES
FILE_WRITE_DAC
FILE_WRITE_DATA
FILE_WRITE_EA
FILE_WRITE_OWNER

BUILTIN\\Administrateurs
Allowed:
FILE_ALL_ACCESS
FILE_APPEND_DATA
FILE_DELETE
FILE_DELETE_CHILD
FILE_EXECUTE
FILE_READ_ATTRIBUTES
FILE_READ_CONTROL
FILE_READ_DATA
FILE_READ_EA
FILE_SYNCHRONIZE
FILE_WRITE_ATTRIBUTES
FILE_WRITE_DAC
FILE_WRITE_DATA
FILE_WRITE_EA
FILE_WRITE_OWNER


bon apres midi
MichelXld

 

[pobrouwers]

re,

Ah OK pour la fenetre exécution du VBE, je connaissais pas...

Je viens de tester en local sur un fichier et effectivement ca fonctionne mais sur un serveur il ne m'indique pas les noms d'utilisateurs, il les remplace par un back slash

Si je comprends bien ta macro, je dois exécuter la marco pour chaque fichier donc changer le chemin a chaque fois.
Ce qui ne m'avance pas car en fait, le but de cette macro serait en fait de remplacer le click droit sur chaque fichier et aller dans security et la je vois les différents acces.

Crois-tu que ce serait possible d'adapter pour que j'indique simplement le repertoire et qu'il scanne sur tous les sous-repertoires qui contiennent un fichier qui commence par LE.

Je suis bien conscient que cela ne va pas être évident...

Merci en tout cas...

bonne aprem

Message édité par: pobrouwers, à: 07/05/2006 17:25

 

[MichelXld]

rebonjour Pobrouwers

lister les classeurs d'un répertoire et des sous repertoires n'est pas vraiment un probleme : tu trouveras de nombreuses macros sur le forum

par exemple :

Sub listeFichiers_Repertoire_SousRepertoires()
Dim Dossier As String

Dossier = 'C:\\\\\\\\Documents and Settings\\\\\\\\michel\\\\\\\\dossier'

ListFilesInFolder Dossier, True
End Sub

Sub ListFilesInFolder(SourceFolderName As String, IncludeSubfolders As Boolean)
' adapté de Ole P Erlandsen
'
Dim Fso As Object, SourceFolder As Object
Dim SubFolder As Object, FileItem As Object

Set Fso = CreateObject('Scripting.FileSystemObject')
Set SourceFolder = Fso.GetFolder(SourceFolderName)

For Each FileItem In SourceFolder.Files
If Right(FileItem.Name, 4) = '.xls' Then
Debug.Print FileItem.Path
End If

Next FileItem

If IncludeSubfolders Then 'recherche dans les sous repertoires
For Each SubFolder In SourceFolder.subfolders
ListFilesInFolder SubFolder.Path, True
Next SubFolder
End If

End Sub



par contre si les noms des utilisateurs ne sont pas indiqués lorsque tu fais une recherche le serveur, tu vas etre bloqué : peut etre faut il avoir le profil administrateur ...



bonne soiree
MichelXld

Message édité par: michelxld, à: 07/05/2006 18:14

 

[pobrouwers]

Merci Michel,

Pour lister les fichiers d'un répertoire et d'un sous répertoire, j'avais déja vu cette solution que j'utilise d'ailleurs dans d'autres applications...

Je crois que je vais laisser tomber ce probleme car a mon avis ca semble etre complexe via excel.

Je vais me tourner vers un autre programme qui gere les droits sous le serveur linux.

En tout cas merci pour ton aide, Michel.

C'est toujours un plaisir...

 

[Thierry]

Bonjour,

Je suis moi aussi à la recherche de cette fonctionnalité.
La macro fonctionne parfaitement lorsque je travaille sur un disque local ou un disque 'mappé'.
Par contre, je n'arrive pas à l'exécuter sur un dossier dont le nom est passé en UNC (par ex : \\\\serveur\\folder )
Y-a-t'il un moyen d'utiliser cette syntaxe ?
Merci


Thierry

 

[pobrouwers]

Bonjour Thierry,

Je n'y suis pas parvenu sur un serveur.

Désolé...