Here's an example that you can mine to do what you need to do. Requires that
CDO 1.21 is installed.
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
'folder you want to give UserA 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
MsgBox oACEs.Count
oACEs.Add oNewAce
oACLObject.Update
MsgBox oACEs.Count
oSession.Logoff
' Indicate the process is finished.
MsgBox "Completed adding " & UserA & " to Inbox permissions for " &
UserB & "."
ErrorHandler:
MsgBox "Error " & Err.Number & vbCr & Err.Description, vbOKOnly
End Sub
--
Eric Legault (Outlook MVP, MCDBA, old school WOSA MCSD, B.A.)
Try Picture Attachments Wizard for Outlook:
http://www.collaborativeinnovations.ca
Blog:
http://blogs.officezealot.com/legault/
"Steve" wrote:
> Hi - I am looking for a way to have a user run any of:
> VBA/VBScript/Jscript/ActiveX to add a reviewer to their sent items
> folder. From a security point of view, I can see why this shouldn't be
> easy... Anybody know if this is possible and if so How we can do it?
>
> I can't find any way to automate this process from the client side. We
> would love to do this from the server side, but policies/regulations
> prohibit this. SMS scripting is another possibility, but not attractive.
>
> Some background:
> We have a software tool that indexes a users sent items folders to
> enable collaboration via people searches. It's a nice tool and privacy
> is respected. Having said that, we need to ask the users to manually
> add the Scanning account as a reviwer for their sent items folder.
> Needless to say, we need to send out frequent reminders to have the
> people perform this 40 second, 3 step procedure...
>
> Thanks!
> Steve
>
Similar Threads
