Setting exchange folder properties thro CDO and ACL.dll

  • Thread starter Thread starter nkesu
  • Start date Start date
N

nkesu

I am trying to set the Role and the Permissions for a public folder in
Exchange (5.5), using CDO and ACL.dll. However, it seems that ACL will
allow only reading of the existing information. There seems to be no
provision for setting the permissions. Is that right? Or am I
overlooing something.

If it can be done, please provide a pointer or sample...

Thanks
 
Try this code. I had it working at one point, but for some reason today the
ACL library won't instantiate. Anyways, it'll give you an idea of what to do.

Private Sub AddUserToFolder()
On Error GoTo ErrorHandler

Const CdoDefaultFolderCalendar = 0
Const CdoDefaultFolderInbox = 1
Const CdoDefaultFolderOutbox = 2
Const CdoDefaultFolderSentItems = 3
Const CdoDefaultFolderDeletedItems = 4
Const CdoDefaultFolderContacts = 5
Const CdoDefaultFolderJournal = 6
Const CdoDefaultFolderNotes = 7
Const CdoDefaultFolderTasks = 8
Const CdoDefaultFolderTotal = 9

Const ROLE_OWNER = &H5E3
Const ROLE_PUBLISH_EDITOR = &H4E3
Const ROLE_EDITOR = &H463
Const ROLE_PUBLISH_AUTHOR = &H49B
Const ROLE_AUTHOR = &H41B
Const ROLE_NONEDITING_AUTHOR = &H413
Const ROLE_REVIEWER = &H401
Const ROLE_CONTRIBUTOR = &H402
Const ROLE_NONE = &H400

Dim strProfile As String
Dim oSession As Object 'MAPI.Session
Dim oAddrBook As Object 'MAPI.AddressList
Dim oDelegate As Object 'MAPI.AddressEntry
Dim oInbox As Object 'MAPI.Folder
Dim oMailbox As Object 'MAPI.InfoStore
Dim oACLObject As ACLObject
Dim oACEs As IACEs
Dim oNewAce As Object

'Change this to the display name of the user you want to give delegate
access.
Const UserA = "Joe Blow" 'must use full name to retrieve an AddressEntry
by name
'from the AddressEntries.Item collection
'--------------------------------------------------

'Change this to the display name of the user whose
'calendar you want to give UserA delegate access to.
Const UserB = "Jane Doe"

'Change server_name to the name of your Exchange server.
strProfile = "servername" & vbLf & UserB

' Create a new MAPI session and log on.
Set oSession = CreateObject("MAPI.Session")
oSession.Logon , , False, True, , True, strProfile

' Create a MAPI object for UserA
Set oAddrBook = oSession.AddressLists("Global Address List")

'This calls the Outlook Object Model guard
Set oDelegate = oAddrBook.AddressEntries.Item(UserA)
'If the user clicks no, this error will be generated:
'Error: "[Collaboration Data Objects - [E_ACCESSDENIED(80070005)]]"
'Number: -2147024891

' Get the permission list on UserB's inbox

MsgBox "Adding " & UserA & " to the Inbox permissions for " & UserB & "
with Reviewer settings."

Set oInbox = oSession.GetDefaultFolder(CdoDefaultFolderInbox)
Set oACLObject = CreateObject("MSExchange.ACLObject")
oACLObject.CDOItem = oInbox
Set oACEs = oACLObject.ACEs

' Add UserA to the permission list and save the result

Set oNewAce = CreateObject("MSExchange.ACE")

oNewAce.ID = oDelegate.ID
oNewAce.Rights = ROLE_REVIEWER
oACEs.Add oNewAce
oACLObject.Update
oSession.Logoff

' Indicate the process is finished.
MsgBox "Completed adding " & UserA & " to Inbox permissions for " &
UserB & "."

finish:

Exit Sub

ErrorHandler:
MsgBox "Error " & Err.Number & vbCr & Err.Description, vbOKOnly
End Sub
 
Back
Top