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.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 |
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 |
You must log in to post a comment.