Add Reviewer to User Folder Permissions

  • Thread starter Thread starter Steve
  • Start date Start date
S

Steve

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
 
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 - Thanks! I'll check this out and let you know, but in any case,
thanks for making this code available to me.

Steve
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
Click to expand...
 
So -- it looks like I would need to specify the Distnguished Name and
load CDO and possibly ACL.dll on the clients machine... I found CDO.DLL
on my work computer, but I'm not sure if it's registered.

The following two definitions cause me a problem, saying the user
Defined type is not defined. If I can fix this error, I might be able
to get this to work in our environement :-)

Thanks!
Steve
Eric - Thanks! I'll check this out and let you know, but in any case,
thanks for making this code available to me.

Steve
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
Click to expand...
Click to expand...
 
If you have CDO.dll, it is most likely registered. It comes from Office, but
it is an optional install. This link (although old) shows how to add the
optional CDO component in Office setup:

Installing CDO with Outlook or Office 2000:
http://www.imibo.com/imidev/delphi/les/installing_cdo_with_outlook.htm

Also, ACL.dll is not usually present on most computers. It is part of the
Platform SDK and must be compiled and distributed with your solution.
However, you can download it via a link in this blog:

MS Exchange Blog : Setting calendar permissions centrally...:
http://hellomate.typepad.com/exchange/2003/07/setting_calenda.html

If you'd like more awesome sample code on using the ACL component, there's
more here:

How To Use ACL Object and CDO (1.21) to List Folder Permissions for a MAPI
Folder:
http://support.microsoft.com/default.aspx?scid=kb;en-us;240911

--
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 said:
So -- it looks like I would need to specify the Distnguished Name and
load CDO and possibly ACL.dll on the clients machine... I found CDO.DLL
on my work computer, but I'm not sure if it's registered.

The following two definitions cause me a problem, saying the user
Defined type is not defined. If I can fix this error, I might be able
to get this to work in our environement :-)

Thanks!
Steve
Eric - Thanks! I'll check this out and let you know, but in any case,
thanks for making this code available to me.

Steve
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
Click to expand...
Click to expand...
Click to expand...
 
Back
Top