Using the Redemption object you can use the following code to reset the permissions on a folders sub folders in outlook to leave the Default permissions.
Handy if you need to reset permissions on large numbers of folders.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 |
Sub scall() Dim TopFolder Set mySession = CreateObject("Redemption.RDOSession") mySession.Logon Set TopFolder = mySession.PickFolder For i = 1 To TopFolder.Folders.Count Debug.Print ">>>>>>>>>>>>>>>>>>>>>>>>>>>>>> " & TopFolder.Folders(i).Name For Each ace In TopFolder.Folders (i).ACL Debug.Print ace.Name & " - " & ace.rights If ace.Name "Default" Then ace.Delete Debug.Print ">>>>>>>>>>>>>>> Deleted " & ace.Name Else If ace.rights > 0 Then ace.rights = 0 Debug.Print "<<<<<<<<<<<<<<< Rights Reset" Else Debug.Print "< Rights default" End If End If Next Next End Sub |