Forum |  HardWare.fr | News | Articles | PC | S'identifier | S'inscrire | Shop Recherche
907 connectés 

  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

  Problème lors de la modification des droits NTFS par vba

 
 


 Mot :   Pseudo :  
 
Bas de page
Auteur Sujet :

Problème lors de la modification des droits NTFS par vba

n°2202254
noisette49
Posté le 09-09-2013 à 09:57:56  profilanswer
 

Bonjour,
Ayant régulièrement des droits à changer sur notre réseau,  
J'ai crée le code ci-dessous qui me permet de changer les droits sur des répertoires pour un groupe de personnes.
Ca marche très bien en controle total, en lecture ou en ecriture.
Le hic est lorsque je veux que le groupe ait seulement un affichage du contenu du dossier.
Dans les droits du répertoire concerné, les droits apparaissent bien en affichage seul, mais les fichiers dessous sont en lecture écriture pour le groupe de personnes concernées alors qu'en fait, le groupe ne devrait pas apparaitre dans les droits des fichiers.
Quelqu'un pourrait -il m'aider et me dire ce que j'ai oublié dans mon code?
J'espère avoir été claire dans ma demande
Merci de votre aide
 
 

Code :
  1. Sub Lancement()
  2. With Application.FileDialog(msoFileDialogFolderPicker)
  3.     .Show
  4.     If .SelectedItems.Count > 0 Then
  5.         Sheets("Lancement" ).Range("B2" ) = .SelectedItems(1)
  7.         Chang_droits
  9.     End If
  10. End With
  11. End Sub
  12. Sub Chang_droits()
  13. flder = Sheets("Lancement" ).Range("B2" )
  14. Sheets("Changement de Droits" ).Select
  15. idx = Sheets("Changement de Droits" ).Range("A1048576" ).End(xlUp).Row
  16. idx1 = Sheets("Changement de Droits" ).Range("D1048576" ).End(xlUp).Row
  17. If idx > 1 Then
  18.     If idx > idx1 Or idx = idx1 Then Rows("2:" & idx).Delete Shift:=xlUp
  19.     If idx1 > idx Then Rows("2:" & idx1).Delete Shift:=xlUp
  20. End If
  21. 'Application.ScreenUpdating = False
  22. TousLesDossiers Sheets("Lancement" ).Range("B2" ), 0
  23. ActiveWorkbook.Save
  24. Message = MsgBox("La modification des droits est terminée", vbInformation)
  25. 'Application.ScreenUpdating = True
  26. End Sub
  27. Public Sub TousLesDossiers(LeDossier$, idx As Long)
  29. Set fso = CreateObject("Scripting.FileSystemObject" )
  30. Set Dossier = fso.GetFolder(LeDossier)
  31.     ' changement dans le répertoire parent
  32.     idx = Sheets("Changement de Droits" ).Range("A1048576" ).End(xlUp).Row
  33.     If idx = 1 Then
  34.         idx = idx + 1
  35.         StrComputer = "."
  36.         StrDomain = "MAIL"
  37.         StrUtype = "u"
  38.         If Sheets("Lancement" ).Range("B3" ) <> "" Then
  39.             Err = 0
  40.             StrFilePath = Dossier
  41.             Sheets("Changement de Droits" ).Cells(idx, 1).Value = StrFilePath
  42.             StrUsername = Sheets("Lancement" ).Range("B3" )
  43.             StrMode = "d"
  44.             GetFolderInfo StrComputer, StrFilePath, StrUsername, StrDomain, StrAccessLvl, StrUtype, StrMode, idx
  45.         End If
  46.         If Sheets("Lancement" ).Range("B4" ) <> "" Then
  47.             StrFilePath = Dossier
  48.             If idx >= 2 Then idx = Sheets("Changement de Droits" ).Range("A1048576" ).End(xlUp).Row + 1
  49.             Err = 0
  50.             Sheets("Changement de Droits" ).Cells(idx, 1).Value = StrFilePath
  51.             StrUsername = Sheets("Lancement" ).Range("B4" )
  52.             StrMode = "d"
  53.             idx1 = idx - 1
  54.             GetFolderInfo StrComputer, StrFilePath, StrUsername, StrDomain, StrAccessLvl, StrUtype, StrMode, idx
  55.             If idx >= 2 Then idx = Sheets("Changement de Droits" ).Range("A1048576" ).End(xlUp).Row + 1
  56.             If idx = idx1 + 2 Then
  57.                 Err = 0
  58.                 StrFilePath = Dossier
  59.                 StrAccessLvl = ""
  60.                 StrUsername = Sheets("Lancement" ).Range("B5" )
  61.                 StrMode = "a"
  62.                 GetFolderInfo StrComputer, StrFilePath, StrUsername, StrDomain, StrAccessLvl, StrUtype, StrMode, idx
  63.             End If
  64.         End If
  65.         If Sheets("Lancement" ).Range("B6" ) <> "" Then
  66.             If idx >= 2 Then idx = Sheets("Changement de Droits" ).Range("A1048576" ).End(xlUp).Row + 1
  67.             Err = 0
  68.             StrFilePath = Dossier
  69.             StrUsername = Sheets("Lancement" ).Range("B6" )
  70.             StrMode = "a"
  71.             If Sheets("Lancement" ).Range("C6" ) <> "" Then
  72.                 StrAccessLvl = "a"
  73.             ElseIf Sheets("Lancement" ).Range("D6" ) <> "" Then
  74.                 StrAccessLvl = "r"
  75.             ElseIf Sheets("Lancement" ).Range("E6" ) <> "" Then
  76.                 StrAccessLvl = "w"
  77.             ElseIf Sheets("Lancement" ).Range("F6" ) <> "" Then
  78.                 StrAccessLvl = "f"
  79.             End If
  80.             GetFolderInfo StrComputer, StrFilePath, StrUsername, StrDomain, StrAccessLvl, StrUtype, StrMode, idx
  81.         End If
  82.         If Sheets("Lancement" ).Range("B7" ) <> "" Then
  83.             Err = 0
  84.             StrFilePath = Dossier
  85.             StrUsername = Sheets("Lancement" ).Range("B7" )
  86.             StrMode = "m"
  87.             If Sheets("Lancement" ).Range("C7" ) <> "" Then
  88.                 StrAccessLvl = "a"
  89.             ElseIf Sheets("Lancement" ).Range("D7" ) <> "" Then
  90.                 StrAccessLvl = "r"
  91.             ElseIf Sheets("Lancement" ).Range("E7" ) <> "" Then
  92.                 StrAccessLvl = "w"
  93.             ElseIf Sheets("Lancement" ).Range("F7" ) <> "" Then
  94.                 StrAccessLvl = "f"
  95.             End If
  96.             GetFolderInfo StrComputer, StrFilePath, StrUsername, StrDomain, StrAccessLvl, StrUtype, StrMode, idx
  97.         End If
  98.     End If
  100.     For Each flder In Dossier.subfolders
  101.         If idx > 1 Then
  102.             idx = Sheets("Changement de Droits" ).Range("D1048576" ).End(xlUp).Row
  103.         Else
  104.             idx = Sheets("Changement de Droits" ).Range("A1048576" ).End(xlUp).Row
  105.         End If
  106.         If idx = 1 Then StrFilePath = Dossier
  107.         idx = idx + 1
  108.         StrComputer = "."
  109.         StrDomain = "MAIL"
  110.         StrUtype = "u"
  111.         If Sheets("Lancement" ).Range("B3" ) <> "" Then
  112.             Err = 0
  113.             Sheets("Changement de Droits" ).Cells(idx, 1).Value = flder.path
  114.             StrUsername = Sheets("Lancement" ).Range("B3" )
  115.             StrFilePath = flder.path
  116.             StrMode = "d"
  117.             GetFolderInfo StrComputer, StrFilePath, StrUsername, StrDomain, StrAccessLvl, StrUtype, StrMode, idx
  118.         End If
  119.         If Sheets("Lancement" ).Range("B4" ) <> "" Then
  120.             Err = 0
  121.             If idx >= 2 Then idx = Sheets("Changement de Droits" ).Range("A1048576" ).End(xlUp).Row + 1
  122.             Sheets("Changement de Droits" ).Cells(idx, 1).Value = flder.path
  123.             StrUsername = Sheets("Lancement" ).Range("B4" )
  124.             StrFilePath = flder.path
  125.             StrMode = "d"
  126.             idx1 = idx - 1
  127.             GetFolderInfo StrComputer, StrFilePath, StrUsername, StrDomain, StrAccessLvl, StrUtype, StrMode, idx
  128.            
  129.             If idx >= 2 Then idx = Sheets("Changement de Droits" ).Range("A1048576" ).End(xlUp).Row + 1
  130.             If idx = idx1 + 2 Then
  131.                 Err = 0
  132.                 StrAccessLvl = ""
  133.                 StrUsername = Sheets("Lancement" ).Range("B5" )
  134.                 StrFilePath = flder.path
  135.                 StrMode = "a"
  136.                 GetFolderInfo StrComputer, StrFilePath, StrUsername, StrDomain, StrAccessLvl, StrUtype, StrMode, idx
  137.             End If
  138.         End If
  139.         If Sheets("Lancement" ).Range("B6" ) <> "" Then
  140.             If idx >= 2 Then idx = Sheets("Changement de Droits" ).Range("A1048576" ).End(xlUp).Row + 1
  141.             Err = 0
  142.             StrUsername = Sheets("Lancement" ).Range("B6" )
  143.             StrFilePath = flder.path
  144.             StrMode = "a"
  145.             If Sheets("Lancement" ).Range("C6" ) <> "" Then
  146.                 StrAccessLvl = "a"
  147.             ElseIf Sheets("Lancement" ).Range("D6" ) <> "" Then
  148.                 StrAccessLvl = "r"
  149.             ElseIf Sheets("Lancement" ).Range("E6" ) <> "" Then
  150.                 StrAccessLvl = "w"
  151.             ElseIf Sheets("Lancement" ).Range("F6" ) <> "" Then
  152.                 StrAccessLvl = "f"
  153.             End If
  154.             GetFolderInfo StrComputer, StrFilePath, StrUsername, StrDomain, StrAccessLvl, StrUtype, StrMode, idx
  155.         End If
  156.         If Sheets("Lancement" ).Range("B7" ) <> "" Then
  157.             Err = 0
  158.             StrUsername = Sheets("Lancement" ).Range("B7" )
  159.             StrFilePath = flder.path
  160.             StrMode = "m"
  161.             If Sheets("Lancement" ).Range("C7" ) <> "" Then
  162.                 StrAccessLvl = "a"
  163.             ElseIf Sheets("Lancement" ).Range("D7" ) <> "" Then
  164.                 StrAccessLvl = "r"
  165.             ElseIf Sheets("Lancement" ).Range("E7" ) <> "" Then
  166.                 StrAccessLvl = "w"
  167.             ElseIf Sheets("Lancement" ).Range("F7" ) <> "" Then
  168.                 StrAccessLvl = "f"
  169.             End If
  170.             GetFolderInfo StrComputer, StrFilePath, StrUsername, StrDomain, StrAccessLvl, StrUtype, StrMode, idx
  171.         End If
  172.     Next
  173.     'traitement récursif des sous dossiers
  174.     For Each SousRep In Dossier.subfolders
  175.         TousLesDossiers SousRep.path, idx
  176.     Next SousRep
  177.     Set fso = Nothing
  178. End Sub
  179. Function GetFolderInfo(StrComputer, StrFilePath, StrUsername, StrDomain, StrAccessLvl, StrUtype, StrMode, idx)
  180.     Dim dacl, Services, SecDescClass, SecDesc, intRetVal
  181.     Dim wmiFileSecSetting, wmiFileSetting, wmiSecurityDescriptor
  182.     Dim strMsg, objACE
  183.    
  184.     Set Services = GetObject("winmgmts:{impersonationLevel=impersonate,(Security)}!\\" & StrComputer & "\ROOT\CIMV2" )
  185.     Set SecDescClass = Services.get("Win32_SecurityDescriptor" )
  186.     Set SecDesc = SecDescClass.SpawnInstance_
  187.    
  188.     On Error GoTo suite
  189.    
  190.     Set wmiFileSetting = GetObject("Winmgmts:{impersonationlevel=impersonate}!//" & StrComputer & "/root/CIMV2:Win32_Directory='" & StrFilePath & "'" )
  191.     Set wmiFileSecSetting = GetObject("winmgmts:{impersonationLevel=impersonate,(Security)}!\\" & StrComputer & "\ROOT\CIMV2:Win32_LogicalFileSecuritySetting.path='" & StrFilePath & "'" )
  193.     'you can have problems here if you have no descriptor ie only everyone listed.
  194.     intRetVal = wmiFileSecSetting.getsecuritydescriptor(wmiSecurityDescriptor)
  195.     ' Obtain existing security descriptor for folder
  196.     If Err <> 0 Then
  197.         Message = MsgBox("GetSecurityDescriptor failed" & vbCrLf & Err.Number & vbCrLf & Err.Description, vbOKOnly)
  198.     End If
  199.     ' Retrieve the content of Win32_SecurityDescriptor DACL property.
  200.     dacl = wmiSecurityDescriptor.dacl
  201.     trouve = ""
  202.     If StrMode = "d" Or StrMode = "m" Then
  203.         For Each objACE In dacl
  204.             If UCase(objACE.trustee.name) = UCase(StrUsername) Then
  205.                 If Sheets("Changement de Droits" ).Cells(idx, 1) = "" Then Sheets("Changement de Droits" ).Cells(idx, 1) = StrFilePath
  206.                 Sheets("Changement de Droits" ).Cells(idx, 2) = UCase(StrUsername)
  207.                 Sheets("Changement de Droits" ).Cells(idx, 3) = objACE.accessmask
  208.                 Sheets("Changement de Droits" ).Cells(idx, 4) = objACE.AceFlags
  209.                 Sheets("Changement de Droits" ).Cells(idx, 5) = objACE.AceType
  210.                 trouve = "X"
  211.                 idx = idx + 1
  212.                 Exit For
  213.             End If
  214.         Next
  215.     End If
  216.     If (trouve = "X" And (StrMode = "d" Or StrMode = "m" )) Or (trouve = "" And StrMode = "a" ) Then
  217.         If StrMode = "d" Then 'delete user
  218.             SecDesc.Properties_.Item("DACL" ) = DeleteUserAce(dacl, StrUsername, StrDomain, StrUtype, StrComputer, Services)
  219.             Sheets("Changement de Droits" ).Cells(idx - 1, 6) = ("deleting " & StrUsername & " to the dacl for " & Replace(StrFilePath, "\\", "\" ) & "." & vbCrLf & "Result of change: " & wmiFileSetting.changesecuritypermissions(SecDesc, 4))
  220.             idx = Sheets("Changement de Droits" ).Range("A1048576" ).End(xlUp).Row
  221.             Sheets("Changement de Droits" ).Cells(idx, 7) = "GROUPE SUPPRIME DU REPERTOIRE"
  222.            
  223.         Else
  224.             If StrMode = "a" Then    'add user
  225.                 AddUserAce dacl, StrUsername, StrDomain, StrUtype, StrComputer, StrAccessLvl, Services
  226.                 SecDesc.Properties_.Item("DACL" ) = dacl
  227.                 Sheets("Changement de Droits" ).Cells(idx, 1) = StrFilePath
  228.                 Sheets("Changement de Droits" ).Cells(idx, 6) = ("adding " & StrUsername & " to the dacl for " & Replace(StrFilePath, "\\", "\" ) & "." & vbCrLf & "Result of change: " & wmiFileSetting.changesecuritypermissions(SecDesc, 4))
  229.                 idx = Sheets("Changement de Droits" ).Range("A1048576" ).End(xlUp).Row
  230.                 Sheets("Changement de Droits" ).Cells(idx, 7) = "GROUPE AJOUTE AU REPERTOIRE"
  231.                 StrAccessLvl = ""
  232.             Else 'Must mean modify access 8), note this one only returns string, not Ace Array.
  233.                 ModifyUserAce wmiSecurityDescriptor.dacl, StrUsername, StrAccessLvl
  234.                
  235.                 'only need this to modify an entry
  236.                 intRetVal = wmiFileSecSetting.SetSecurityDescriptor(wmiSecurityDescriptor)
  237.                 GetResultMessageFile intRetVal, Replace(StrFilePath, "\\", "\" ), StrUsername
  238.                 Sheets("Changement de Droits" ).Cells(idx, 7) = "DROITS DU GROUPE MODIFIE POUR CE REPERTOIRE"
  240.             End If
  241.         End If
  242.     Else
  243. suite:
  244.         idx = Sheets("Changement de Droits" ).Range("B1048576" ).End(xlUp).Row + 1
  245.         compt = Sheets("Répertoires_en_erreur" ).Range("A1048576" ).End(xlUp).Row + 1
  246.         If Err.Number <> 0 Then
  247.             Sheets("Répertoires_en_erreur" ).Cells(compt, 1) = Sheets("Changement de Droits" ).Cells(idx, 1)
  248.             Sheets("Répertoires_en_erreur" ).Cells(compt, 2) = Err.Number
  249.             Sheets("Répertoires_en_erreur" ).Cells(compt, 3) = Err.Description
  250.         End If
  251.         Sheets("Changement de Droits" ).Cells(idx, 1).ClearContents
  252.     End If
  253.     Set objACE = Nothing
  254.     Set Services = Nothing
  255.     Set SecDescClass = Nothing
  256.     Set SecDesc = Nothing
  257.     Set wmiFileSecSetting = Nothing
  258.     Set wmiFileSetting = Nothing
  259. End Function
  260. Function DeleteUserAce(ByRef dacl, StrUsername, StrDomain, StrUtype, StrComputer, ByRef Services)
  261. '    Copy dacl to new ACE array Leaving out the one not.
  262.     Dim intArrAceMax, arrACE, i, objACE
  263.     intArrAceMax = UBound(dacl)
  264.     ReDim arrACE(intArrAceMax)
  265.     i = 0
  266.     For Each objACE In dacl
  267.         If UCase(objACE.trustee.name) <> UCase(StrUsername) Then
  268.             Set arrACE(i) = Services.get("Win32_Ace" ).SpawnInstance_
  269.             arrACE(i).Properties_.Item("AccessMask" ) = objACE.accessmask
  270.             arrACE(i).Properties_.Item("AceFlags" ) = objACE.AceFlags
  271.             arrACE(i).Properties_.Item("AceType" ) = objACE.AceType
  272.             arrACE(i).Properties_.Item("Trustee" ) = objACE.trustee
  273.             i = i + 1
  274.         End If
  275.     Next
  276.    
  277.     If intArrAceMax > i - 1 Then
  278. '        Message = MsgBox("User/Group " & StrUsername & " removed.", vbOKOnly)
  279.         ReDim Preserve arrACE(intArrAceMax - 1)
  280.     Else
  281.         Message = MsgBox("User/Group " & StrUsername & " not found." & flder, vbOKOnly)
  282.     End If
  283.    
  284.     DeleteUserAce = arrACE
  285.     For i = 0 To intArrAceMax - 1
  286.         Set arrACE(i) = Nothing
  287.     Next
  288.     Set objACE = Nothing
  289. End Function
  290. Function AddUserAce(ByRef dacl, StrUsername, StrDomain, StrUtype, StrComputer, StrAccessLvl, ByRef Services)
  291.     'Copy dacl to new ACE array then add specified user/group to ACE array and return it.
  292.     intArrAceMax = UBound(dacl) + 1
  293.     ReDim Preserve dacl(intArrAceMax)
  294.     idx = Sheets("Changement de Droits" ).Range("A1048576" ).End(xlUp).Row
  295.     Set dacl(intArrAceMax) = Services.get("Win32_Ace" ).SpawnInstance_
  296.     If Sheets("Lancement" ).Range("B5" ) <> "" And StrAccessLvl = "" Then
  297.         dacl(intArrAceMax).Properties_.Item("AccessMask" ) = Sheets("Changement de Droits" ).Cells(idx, 3).Value
  298.         dacl(intArrAceMax).Properties_.Item("AceFlags" ) = Sheets("Changement de Droits" ).Cells(idx, 4).Value
  299.         idx = idx + 1
  300.     Else
  301.        
  302.         If StrAccessLvl = "a" Then
  303.             dacl(intArrAceMax).Properties_.Item("AccessMask" ) = 1179817
  304.             dacl(intArrAceMax).Properties_.Item("AceFlags" ) = 2
  305.         ElseIf StrAccessLvl = "r" Then
  306.             dacl(intArrAceMax).Properties_.Item("AccessMask" ) = 1179817
  307.             dacl(intArrAceMax).Properties_.Item("AceFlags" ) = 3
  308.         ElseIf StrAccessLvl = "w" Then
  309.             dacl(intArrAceMax).Properties_.Item("AccessMask" ) = 1245631
  310.             dacl(intArrAceMax).Properties_.Item("AceFlags" ) = 3
  311.         Else 'full access
  312.             dacl(intArrAceMax).Properties_.Item("AccessMask" ) = 2032127
  313.             dacl(intArrAceMax).Properties_.Item("AceFlags" ) = 3
  314.         End If
  315.         idx = idx + 1
  316.     End If
  317.    
  318.    
  319.     Sheets("Changement de Droits" ).Cells(idx, 2) = StrUsername
  320.     Sheets("Changement de Droits" ).Cells(idx, 3) = dacl(intArrAceMax).Properties_.Item("AccessMask" )
  321.     Sheets("Changement de Droits" ).Cells(idx, 4) = dacl(intArrAceMax).Properties_.Item("AceFlags" )
  322.    
  323.     dacl(intArrAceMax).Properties_.Item("AceType" ) = 0
  324.     Sheets("Changement de Droits" ).Cells(idx, 5) = dacl(intArrAceMax).Properties_.Item("AceType" )
  325.     dacl(intArrAceMax).Properties_.Item("Trustee" ) = GetObjTrustee(StrUsername, StrDomain, StrUtype, StrComputer)
  326.     Set objACE = Nothing
  327. End Function
  328. Function GetObjTrustee(StrUsername, StrDomain, StrUtype, StrComputer)
  329.     'Get and user/group object to copy user/group sid to new trustee instance to be returned
  330.     Dim objTrustee, account, accountSID
  331.     Set objTrustee = GetObject("Winmgmts:{impersonationlevel=impersonate}!//" & StrComputer & "/root/cimv2:Win32_Trustee" ).SpawnInstance_
  332.     'For some reason you can't seem to be able to connect remotely to get account.
  333.     If StrUtype = "g" Then
  334.         'Set account = getObject("Winmgmts:{impersonationlevel=impersonate}!//" & strComputer & "/root/cimv2:Win32_Group.Name='" & strUsername & "',Domain='" & strDomain &"'" )
  335.         Set account = GetObject("Winmgmts:{impersonationlevel=impersonate}!//./root/cimv2:Win32_Group.Name='" & Chr(34) & StrUsername & Chr(34) & "',Domain='" & StrDomain & "'" )
  336.     Else
  337.         'Set account = getObject("Winmgmts:{impersonationlevel=impersonate}!//" & strComputer & "/root/cimv2:Win32_Account.Name='" & strUsername & "',Domain='" & strDomain &"'" )
  338.         Set account = GetObject("Winmgmts:{impersonationlevel=impersonate}!//./root/cimv2:Win32_Account.Name='" & StrUsername & "',Domain='" & StrDomain & "'" )
  339.     End If
  340.     Set accountSID = GetObject("Winmgmts:{impersonationlevel=impersonate}!//" & StrComputer & "/root/cimv2:Win32_SID.SID='" & account.SID & "'" )
  341.     objTrustee.Domain = StrDomain
  342.     objTrustee.name = StrUsername
  343.     objTrustee.Properties_.Item("SID" ) = accountSID.BinaryRepresentation
  344.     Set GetObjTrustee = objTrustee
  345.     Set accountSID = Nothing
  346.     Set account = Nothing
  347.     Set objTrustee = Nothing
  348. End Function
  349. Function ModifyUserAce(ByRef dacl, StrUsername, StrAccessLvl)
  350.     'Modify dacl ACE entry with new accessmask.
  351.     Dim strMsg, objACE
  352.     strMsg = "User/Group: " & StrUsername & " not found in dacl"
  353.     For Each objACE In dacl
  354.         If UCase(objACE.trustee.name) = UCase(StrUsername) Then
  355.             If StrAccessLvl = "a" Then
  356.                 objACE.Properties_.Item("AccessMask" ) = 1179817
  357.                 objACE.Properties_.Item("AceFlags" ) = 2
  358.             ElseIf StrAccessLvl = "r" Then
  359.                 objACE.Properties_.Item("AccessMask" ) = 1179817
  360.                 objACE.Properties_.Item("AceFlags" ) = 3
  361.             ElseIf StrAccessLvl = "w" Then
  362.                 objACE.Properties_.Item("AccessMask" ) = 1245631
  363.                 objACE.Properties_.Item("AceFlags" ) = 3
  364.             Else 'full access: didn't work in w2k - 131072 works in w2k - 2032127
  365.                 objACE.Properties_.Item("AccessMask" ) = 2032127
  366.                 objACE.Properties_.Item("AceFlags" ) = 3
  367.             End If
  368.             strMsg = "User: " & StrUsername & " found and modified to have " & StrAccessLvl
  369.             Exit For
  370.         End If
  371.     Next
  372.     Set objACE = Nothing
  373.     ModifyUserAce = strMsg
  374. End Function
  375. Function GetResultMessageFile(errReturn, strSharename, StrUsername)
  376.         If errReturn = 0 Then
  377.             GetResultMessageFile = "File permissions for " & strSharename & " successfully updated!"
  378.         Else
  379.             Select Case errReturn
  380.                 Case 2
  381.                     errDesc = "Access denied."
  382.                 Case 8
  383.                     errDesc = "Unknown failure."
  384.                 Case 9
  385.                     errDesc = "Privledge Missing."
  386.                 Case 10
  387.                     errDesc = "Invalid level."
  388.                 Case 21
  389.                     errDesc = "Invalid parameter."
  390.                 Case 23
  391.                     errDesc = "Redirected path."
  392.                 Case 24
  393.                     errDesc = "Directory does not exist."
  394.                 Case 25
  395.                     errDesc = "Net name not found."
  396.             End Select
  397.          GetResultMessageFile = "Failed to update File permissions for " & strSharename & ". Error number: " & errReturn & ". " & errDesc
  398.         End If
  399. End Function

mood
Publicité
Posté le 09-09-2013 à 09:57:56  profilanswer
 

n°2202707
noisette49
Posté le 12-09-2013 à 13:48:50  profilanswer
 

Re-bonjour
SVP Personne n'a d'idées sur le sujet ?
Peut-etre que je ne suis pas sur le bon forum !
Si c'est le cas merci de me le dire.

n°2203217
c_moa
Posté le 16-09-2013 à 22:09:21  profilanswer
 

Bonjour (ou soir),
je pense que tu es sur le bon forum, mais 399 lignes de code à digérer, cela demande un peu de temps :)  
Et cela peut faire peur, je ne suis pas un fan des commentaires à outrance, mais là, c'est du code quasi brut
 
J'utilise  setacl   http://helgeklein.com/setacl/.
Je trouve personnellement l'outil très bien fait pour écrire ses propre fonctions.
 
 
 
 
 
 

n°2203251
noisette49
Posté le 17-09-2013 à 09:06:29  profilanswer
 

Bonjour,
En effet, je ne m'étais pas rendu compte que le code était si long.
Cependant merci pour le lien, je vais regarder.
Par contre étant donné que setacl fonctionne avec vbsript, je ne sais pas si cela va fonctionné avec du vba.


Aller à :
Ajouter une réponse
  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

  Problème lors de la modification des droits NTFS par vba

 

Sujets relatifs
Problème avec Typeahead[Ada][Débutant POO] Problème d'héritage à l'instantiation d'un paquet
Problème avec jdk 1.8Problème reception données port serie
Petit problème ajax avec JSON[Qt Débutant] QTreeWidget, problème avec les fonctions de bases
problème avec une boucle foreachProbleme Application JAVA Connexion DB MySQL (connector/J driver)
directx 11 inclu dans win7 problème jeu[Qt designer débutant] Problème de connexions des slots
Plus de sujets relatifs à : Problème lors de la modification des droits NTFS par vba

Forum MesDiscussions.Net, Version 2010.2
(c) 2000-2011 Doctissimo
Page générée en 0.209 secondes

Copyright © 1997-2022 Hardware.fr SARL (Signaler un contenu illicite / Données personnelles) / Groupe LDLC / Shop HFR