Eric Legault My Eggo

Accessing Public Folder Permissions Programmatically

I recently came across a need to programmatically access a list of users and permissions for a Public Folder. Seeing as how there is no way to do this with Outlook VBA or CDO, I had to find a way to do this. Luckily, the Exchange 5.5 SDK includes an ACL Component (ACL.dll) that provides an API to access these security settings. The full reference material is here:

http://msdn.microsoft.com/library/default.asp?url=/library/en-us/exchserv/html/comcpnts_8f04.asp.

Exchange MVP Siegfried Weber has also created a Folder Permission Viewer, an excellent utility that not only provides a UI for displaying a treeview of Outlook folders, but recreates the Folder Permissions dialog from Outlook. You can download Sig's sample here:

http://www.cdolive.com/aclviewer.htm.

Both the SDK and Sig's sample were instrumental in helping me solve my problem. It is not rocket science, and I've provided some code below that illustrates how to access the permissions for a given CDO.Folder object. Aside from a Win32API call for accessing NT account information, and a wack of ACL constants, it is pretty easy to see what is going on. All that really happens is an ACLObject for a given folder is retrieved, and through it you get a collection of ACEs (Access Control Entries), one for each user. Each ACLObject in a set of ACEs has the properties that tell us what rights the user has, such as CreateItems, DeleteAll etc. The Rights property provides access to the user's role for that folder - Owner, Author, etc. Another procedure, GetUserInfo, takes the SID (Security Identifier) from an ACLObject to get a CDO AddressEntry object. This lets us get the Exchange DN for the user, as well as their full name (as it appears in the GAL, for example).

You can easily incorporate the VB code below into your solution. As long as you have a valid CDO.Session object initiated, and you pass a CDO.Folder object to the GetPermissions procedure, you are good to go! Just tweak the code as you see fit, based on what you need to do with the users and their rights that you retrieve.

Option Explicit
Private Declare Function LookupAccountSid Lib "advapi32.dll" Alias "LookupAccountSidA" ( _
 ByVal lpSystemName As String, _
 Sid As Any, _
 ByVal name As String, _
 cbName As Long, _
 ByVal ReferencedDomainName As String, _
 cbReferencedDomainName As Long, _
 peUse As Integer _
 ) As Long

'FOLDER RIGHTS
Const ACL_ROLE_OWNER = &H7FB
Const ACL_ROLE_PUBLISH_EDITOR = &H4FB
Const ACL_ROLE_EDITOR = &H47B
Const ACL_ROLE_PUB_AUTHOR = &H49B
Const ACL_ROLE_AUTHOR = &H41B
Const ACL_ROLE_NONEDITING_AUTHOR = &H413
Const ACL_ROLE_REVIEWER = &H401
Const ACL_ROLE_CONTRIBUTOR = &H402
Const ACL_ROLE_ROLE_NONE = &H400

'ACL RIGHTS
Const ACL_ACE_ID_DEFAULT = "ID_ACL_DEFAULT"
Const ACL_ACE_ID_ANONYMOUS = "ID_ACL_ANONYMOUS"
Const ACL_RIGHTS_CREATE_ITEMS = &H2
Const ACL_RIGHTS_READ_ITEMS = &H1
Const ACL_RIGHTS_CREATE_SUBFOLDERS = &H80
Const ACL_RIGHTS_FOLDER_OWNER = &H100
Const ACL_RIGHTS_FOLDER_CONTACT = &H200
Const ACL_RIGHTS_FOLDER_VISIBLE = &H400
Const ACL_RIGHTS_EDIT_OWN = &H8
Const ACL_RIGHTS_EDIT_ALL = &H28
Const ACL_RIGHTS_DEL_OWN = &H10
Const ACL_RIGHTS_DEL_ALL = &H50
Const ACL_RIGHTS_NONE = 0

Const CdoPR_EMS_AB_ASSOC_NT_ACCOUNT = &H80270102

'FOR DETERMINING ACL ROLES
Dim ACL_RIGHTS_OWNER As Long
Dim ACL_RIGHTS_PUB_EDITOR As Long
Dim ACL_RIGHTS_EDITOR As Long
Dim ACL_RIGHTS_PUB_AUTHOR As Long
Dim ACL_RIGHTS_AUTHOR As Long
Dim ACL_RIGHTS_NONEDIT_AUTHOR As Long
Dim ACL_RIGHTS_REVIEWER As Long
Dim ACL_RIGHTS_CONTRIBUTOR As Long
Dim ACL_RIGHTS_ROLE_NONE As Long
Dim ACL_RIGHTS_OWNER_2 As Long
Dim ACL_RIGHTS_ROLE_NONE_2 As Long
Dim ACL_RIGHTS_ROLE_NONE_3 As Long

Dim objSession As MAPI.Session
Dim objMAPIFolder As MAPI.Folder

Sub GetPermissions(objMAPIFolder As MAPI.Folder)    

    If objMAPIFolder Is Nothing Then Exit Sub

    Dim objFolderACE As MSExchangeACLLib.ACE
    Dim objFolderACL As MSExchangeACLLib.ACLObject
    Dim objFolderACEs As MSExchangeACLLib.IACEs
    Dim lngRights As Long

    ' ACL roles, computed of the specific rights
    ACL_RIGHTS_OWNER_2 = ACL_RIGHTS_CREATE_ITEMS Or ACL_RIGHTS_READ_ITEMS _
 Or ACL_RIGHTS_CREATE_SUBFOLDERS Or ACL_RIGHTS_FOLDER_OWNER _
 Or ACL_RIGHTS_FOLDER_VISIBLE _
 Or ACL_RIGHTS_EDIT_ALL Or ACL_RIGHTS_DEL_ALL
    ACL_RIGHTS_OWNER = ACL_RIGHTS_OWNER_2 Or ACL_RIGHTS_FOLDER_CONTACT
    ACL_RIGHTS_PUB_EDITOR = ACL_RIGHTS_CREATE_ITEMS Or ACL_RIGHTS_READ_ITEMS _
 Or ACL_RIGHTS_CREATE_SUBFOLDERS _
 Or ACL_RIGHTS_FOLDER_VISIBLE _
 Or ACL_RIGHTS_EDIT_ALL Or ACL_RIGHTS_DEL_ALL
    ACL_RIGHTS_EDITOR = ACL_RIGHTS_CREATE_ITEMS Or ACL_RIGHTS_READ_ITEMS _
 Or ACL_RIGHTS_FOLDER_VISIBLE _
 Or ACL_RIGHTS_EDIT_ALL Or ACL_RIGHTS_DEL_ALL
    ACL_RIGHTS_PUB_AUTHOR = ACL_RIGHTS_CREATE_ITEMS Or ACL_RIGHTS_READ_ITEMS _
 Or ACL_RIGHTS_CREATE_SUBFOLDERS _
 Or ACL_RIGHTS_FOLDER_VISIBLE _
 Or ACL_RIGHTS_EDIT_OWN Or ACL_RIGHTS_DEL_OWN
    ACL_RIGHTS_AUTHOR = ACL_RIGHTS_CREATE_ITEMS Or ACL_RIGHTS_READ_ITEMS _
 Or ACL_RIGHTS_FOLDER_VISIBLE _
 Or ACL_RIGHTS_EDIT_OWN Or ACL_RIGHTS_DEL_OWN
    ACL_RIGHTS_NONEDIT_AUTHOR = ACL_RIGHTS_CREATE_ITEMS Or ACL_RIGHTS_READ_ITEMS _
 Or ACL_RIGHTS_FOLDER_VISIBLE _
 Or ACL_RIGHTS_DEL_OWN
    ACL_RIGHTS_REVIEWER = ACL_RIGHTS_READ_ITEMS Or ACL_RIGHTS_FOLDER_VISIBLE
    ACL_RIGHTS_CONTRIBUTOR = ACL_RIGHTS_CREATE_ITEMS Or ACL_RIGHTS_FOLDER_VISIBLE
    ACL_RIGHTS_ROLE_NONE = ACL_RIGHTS_FOLDER_VISIBLE
    ACL_RIGHTS_ROLE_NONE_2 = ACL_RIGHTS_NONE
    ACL_RIGHTS_ROLE_NONE_3 = ACL_RIGHTS_FOLDER_CONTACT

   ' Create new folder ACL object
    Set objFolderACL = New MSExchangeACLLib.ACLObject
    If Not objFolderACL Is Nothing Then

 ' Check if valid folder is given
     If Not objMAPIFolder Is Nothing Then

     ' Bind folder and retrieve ACEs
     Set objFolderACL.CDOItem = objMAPIFolder
     Set objFolderACEs = objFolderACL.ACEs

        ' Check if ACEs list not empty
     If objFolderACEs.Count <> 0 Then

                ' Loop through the ACEs list
         For Each objFolderACE In objFolderACEs

      'Check if this user is one of the default roles
             If objFolderACE.ID <> ACL_ACE_ID_DEFAULT And objFolderACE.ID <> ACL_ACE_ID_ANONYMOUS Then
          'IF the user is not one of the above, retrieve more information

                        GetUserInfo objFolderACE.ID

          'Check the appropriate MSExchangeACLLib.ACE properties to see the rights returned
          Debug.Print objFolderACE.CreateItems
          Debug.Print objFolderACE.CreateSubFolders
          Debug.Print objFolderACE.DeleteAll
          Debug.Print objFolderACE.DeleteOwn
          Debug.Print objFolderACE.EditAll
          Debug.Print objFolderACE.EditOwn
          Debug.Print objFolderACE.FolderContact
          Debug.Print objFolderACE.FolderOwner
          Debug.Print objFolderACE.FolderVisible
          Debug.Print objFolderACE.ReadItems

          lngRights = objFolderACE.Rights
          ' Possible values for MSExchangeACLLib.ACE.Rights are the ACL Constants declared above
          'ACL_RIGHTS_OWNER, ACL_RIGHTS_OWNER_2, ACL_RIGHTS_PUB_EDITOR, etc.
      End If
         Next
     End If
        End If
    End If

    ' Destroy objects
    Set objFolderACE = Nothing
    Set objFolderACL = Nothing
    Set objFolderACEs = Nothing
End Sub

Private Sub GetUserInfo(strEntryID)
On Error Resume Next

    ' Declare variables
    Dim objAddressEntry As MAPI.AddressEntry, objFields As MAPI.Fields
    Dim strX As String, intX As Integer
    Dim bByte() As Byte
    Dim tmp As Integer
    Dim i As Integer
    Dim ret As Boolean
    Dim strSID As String
    Dim strName As String
    Dim strDomain As String
    Dim iType As Integer

    ' Get address entry
    Set objAddressEntry = objSession.GetAddressEntry(strEntryID)

    Debug.Print objAddressEntry.Address
    Debug.Print objAddressEntry.name

    Set objFields = objAddressEntry.Fields
    If Err.Number <> 0 Then GoTo Exitt:

    'CODE FOR GETTING THE NT DOMAIN AND USERNAME
    '---------------------------------------------------------------------------

    'Get the PR_EMS_AB_ASSOC_NT_ACCOUNT (&H80270102) field
    strSID = objFields(CdoPR_EMS_AB_ASSOC_NT_ACCOUNT).Value

    'The SID is stored in a hexadecimal representation of the binary SID
    'so we convert it and store it in a byte array
    tmp = Len(strSID) / 2 - 1
    ReDim bByte(tmp) As Byte
    For i = 0 To tmp - 1
     bByte(i) = CInt("&h" & Mid(strSID, (i * 2) + 1, 2))
    Next

    'Allocate space for the strings so the API won't GPF
    strName = Space(64)
    strDomain = Space(64)

    'Get the NT Domain and UserName
    ret = LookupAccountSid(vbNullString, bByte(0), strName, Len(strName), strDomain, Len(strDomain), iType)

    If ret Then 'Strip the Null characters from the returned strings strDomain = Left(strDomain, InStr(strDomain, Chr(0)) - 1)
 strName = Left(strName, InStr(strName, Chr(0)) - 1)
 Debug.Print strDomain & "\" & strName
    Else
 'error!
 Set objAddressEntry = Nothing
        Exit Sub
    End If
    '---------------------------------------------------------------------------

Exitt:
    ' Destroy objects
    Set objAddressEntry = Nothing
    Set objFields = Nothing
    Exit Sub
End Sub