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


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