A user wanted to share several top level folders and their subfolders with a co-worker. changing the permissions on three top=level folders wasn't bad, but there were upwards of 20 subfolders in each folder. Changing the permissions one folder at a time was slow.

While Outlook VBA doesn't support changing folder permissions on its own, you can use it with Redemption to automate changing folder permissions.

This macro changes the subfolder permissions only. You'll need to set the parent folder permission yourself.

1. Download and install Redemption. Verify that Redemption is ticked in Tools > References.
   
2. Add the code to a module.
3. Edit the code to change the two instances of Bo Peep to the person you need to give permission to. You can use their display name or their Exchange alias.
4. Run the macro, select a parent folder.
   
5. The permissions on the subfolders will be updated. Note: this macro only changes the permissions on the first level of subfolders. If you have nested folders, you'll need to do those folder separately or edit the macro to go through the folders recursively.
   

Sub AddFolderPermissions()
Dim ParentFolder
Dim Folder
  Set mySession = CreateObject("Redemption.RDOSession")
  mySession.MAPIOBJECT = Application.Session.MAPIOBJECT

Set ParentFolder = mySession.PickFolder
  For i = 1 To ParentFolder.Folders.Count
  Debug.Print ParentFolder.Folders(i).Name
    Set Folder = ParentFolder.Folders(i)
      For Each ace In Folder.ACL
        Debug.Print ace.Name & " - " & ace.Rights
          If ace.Name <> "Bo Peep" Then
      ' Get Exchange user
          Set AddressEntry = mySession.AddressBook.GAL.ResolveName("Bo Peep")
          Set ace = Folder.ACL.Add(AddressEntry)
            ace.Rights = ROLE_AUTHOR
          End If
      Next
  Next
End Sub

Delete Folder Permissions

This macro deletes all users from Permissions and sets the Default permission to None.

Sub DeleteFolderPermissions()
Dim ParentFolder
Dim Folder
  Set mySession = CreateObject("Redemption.RDOSession")
    mySession.MAPIOBJECT = Application.Session.MAPIOBJECT

Set ParentFolder = mySession.PickFolder
  For i = 1 To ParentFolder.Folders.Count
  Debug.Print ParentFolder.Folders(i).Name
    Set Folder = ParentFolder.Folders(i)
      For Each ace In Folder.ACL
      Debug.Print ace.Name & " - " & ace.Rights
        If ace.Name <> "Default" Then
          ace.Delete
        Else
          If ace.Rights > 0 Then
           ace.Rights = 0
          End If
        End If
      Next
  Next
End Sub

Available Rights and Roles

This is a partial list of Rights and Roles available.

You can use either the role name or the code.
Either of these lines will set the permissions to Author.
ace.Rights = ROLE_AUTHOR
ace.Rights = 1051