Link to home
Start Free TrialLog in
Avatar of LouSch7
LouSch7Flag for United States of America

asked on

Modify Calendar Permissions using VB in ASP Classic

The code provided works perfectly and provides me with a listing of all individuals who have access to the selected users calendar as well as what type of permission they have.

What I am looking to be able to do now is modify/add/remove calendar permissions for the selected person.  So theoretically, there would be a red x that would allow you to effectively remove the person and/or a drop down to change what level of access they have.  There would also be a plus sign or add button near the bottom that would then allow you to search the GAL to add a new individual.
'*******************************************
					'*******************************************
					'START CALENDAR PERMISSIONS INFORMATION SCRIPTS
					'*******************************************
					'*******************************************
					
					On Error Resume Next
					If RSSelectedClient("ClientEmail") Then
						Dim CalendarRights, userDelegate
						Dim strProfileInfo
							
						strServer = "myserver"
						strMailbox = Trim(Left(RSSelectedClient("ClientEmail"),(inStr(RSSelectedClient("ClientEmail"),"@")-1)))						
						
						Const ForReading = 1
						Const ForAppending = 8
						
						Const  RIGHTS_EDIT_OWN = &h8
						Const  RIGHTS_EDIT_ALL = &h20
						Const  RIGHTS_DELETE_OWN = &h10
						Const  RIGHTS_DELETE_ALL = &h40
						Const  RIGHTS_READ_ITEMS = &h1
						Const  RIGHTS_CREATE_ITEMS = &h2
						Const  RIGHTS_CREATE_SUBFOLDERS = &h80
						Const  RIGHTS_FOLDER_OWNER = &h100
						Const  RIGHTS_FOLDER_CONTACT = &h200
						Const  RIGHTS_FOLDER_VISIBLE = &h400
						Const  RIGHTS_NONE = 0
						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
						
						Const CdoDefaultFolderCalendar = 0	
						Const UDefault = "ID_ACL_DEFAULT"
						Const UAnonymous = "ID_ACL_ANONYMOUS"
						
						
						Set objACLObject = CreateObject("MSExchange.ACLObject")
						
						Set objSession = CreateObject("MAPI.Session") 
						
						strProfileInfo = strServer & vbLf & strMailbox 
						
						objSession.Logon , , False, True, , True, strProfileInfo 
						
						'Get the Default Information store and Calendar Folder
						Set objStore = objSession.GetInfoStore("") 
						Set objFolder = objSession.GetDefaultFolder(CdoDefaultFolderCalendar)
						objACLObject.CDOItem = objFolder
						
						Set objACEs = objACLObject.ACEs
						Set objACEs2 = objACLObject.ACEs
						
						userAceCount = 0
						For Each userAce in objACEs2
						
							Select Case userAce.ID
								Case UDefault
									userDelegate = "UDefault"
								Case UAnonymous
									userDelegate = "UAnonymous"
								Case Else
									Set TempEntry = objSession.GetAddressEntry(userAce.ID)
									userDelegate = UCase(TempEntry.Name)
							End Select
						
							Select Case userAce.Rights
								case "0"
									CalendarRights = "none"
								case "2043"
									CalendarRights = "OWNER"
								case "1179"
									CalendarRights = "PUBLISHING AUTHOR"
								case "1147"
									CalendarRights = "EDITOR"
								case "1025"
									CalendarRights = "REVIEWER"
								case "1275"
									CalendarRights = "Publishing Editor"
								case "1051"
									CalendarRights = "Author - 1051"
								case "1563"
									CalendarRights = "Author + Folder Contact - 1563"
								Case "1024"
									CalendarRights = "Folder Visible - 1024"
								Case "1026"
									CalendarRights = "CONTRIBUTOR"
								Case "1043"
									CalendarRights = "NONEDITING_AUTHOR - 1043"
								case "1923"
									CalendarRights = "Custom - All Check Boxes - 1923"
								case "1067"
									CalendarRights = "Custom - Create,Read,Visible + Edit:all,Del:none - 1067"
								case "1035"
									CalendarRights = "Custom - Create,Read,Visible + Edit:own,Del:none - 1035"
								Case else
									CalendarRights = "??custom?? - " & userAce.Rights
							End Select
							
							strDelegate = format_ucase(lcase(userDelegate))
								If inStr(strDelegate ,"Udefault") Then strDelegate = "" Else strDelegate = strDelegate End If
								If inStr(strDelegate ,"Uanonymous") Then strDelegate = "" Else strDelegate = strDelegate End If
							
							strRights = format_ucase(lcase(CalendarRights))
							
							
							strText = format_ucase(lcase(userDelegate)) & " - " & format_ucase(lcase(CalendarRights)) & "<br/>"
							If inStr(strText,"Udefault") Then 
								strText = "" 
								userAceCount = userAceCount - 1
							Else 
								strText = strText 
							End If
							If inStr(strText,"Uanonymous") Then 
								strText = "" 
								userAceCount = userAceCount - 1
							Else 
								strText = strText 
							End If
							finalText = finalText & strText
							userAceCount = userAceCount + 1
						Next
						If Len(finalText) < 10 Then userAceCount = 0 End If
						If userAceCount > 0 Then
							Response.Write "<tr>"
								Response.Write "<td colspan=" & """" & "2" & """" & ">"
									Response.Write "<b><em>User has additional Calendar Permissions set:</em></b><br>"									
									Response.Write finalText
								Response.Write "</td>"
							Response.Write "</tr>"
						End If						
					End If
					'*******************************************
					'*******************************************
					'END CALENDAR PERMISSIONS INFORMATION SCRIPTS
					'*******************************************
					'*******************************************

Open in new window

Avatar of icfire
icfire

This might be better posted in a VB or VBscript zone.
Avatar of LouSch7

ASKER

Is there a way to change the zone?
Avatar of spinzr0
Here is a script that does it for the inbox.  Just modify for calendar.

http://www.eggheadcafe.com/forumarchives/scriptingVisualBasicscript/Jul2005/post23377729.asp
Please let me know if that link isn't helpful.
Avatar of LouSch7

ASKER

It seems helpful I'm just trying to figure out how I'm going to modify it for calendar permissions instead.
Avatar of LouSch7

ASKER

So, trying to use the code directly, just to see how it iterates through so I can hack/slash it into my program...

I receive the following error:

Adding mziegler to the Inbox permissions for sscharla with Reviewer settings. error '800b0003'
/test/members/test.asp, line 82

Line 82 is oACEs.Add oNewACE

Code I am using is below, I replaced my server name with MyServer for security purposes.
<%@ Language=VBScript %>
<!--#include file="inc_header.asp"-->

<%
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  

' Change this to the display name of the user you want    
' to give delegate access.    
Const UserA = "mziegler"  
  
'Change this to the display name of the user whose    
' calendar you want to give UserA delegate access to.    
Const UserB = "sscharla"  
  
'Change server_name to the name of your Exchange server.    
strProfile = "MyServer" & 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")    
Set oDelegate = oAddrBook.AddressEntries.Item(UserA)  
  
' Get the permission list on UserB's inbox    
Response.Write "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_NONE
  
oACEs.Add oNewACE  
  
oACLObject.Update  
  
oSession.Logoff  
  
' Indicate the process is finished.  
  
Response.Write "Completed adding " & UserA & _  
  
" to Inbox permissions for " & UserB & "."  
%>

Open in new window

I get the same error if I runt he code more than once, meaning if the user already has access an I try to add them again.  What you should do it loop through each existing delegate to see if the person already exists before you try to add them.  I can provide some sample code, but probably won't be until tomorrow as I'm ona  deadline.
Actually, I had some code for this already.  Here you go.  As a note, the MailboxOwner's name should be entered as the exchange alias(that is what the field is called in AD).  Let me know if you need help getting that field in AD from the logon name.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Constants for Outlook Folders
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
CONST CALENDAR_FOLDER = 0
CONST INBOX_FOLDER = 1
CONST OUTBOX_FOLDER = 2
CONST SENT_FOLDER = 3
CONST DELETED_FOLDER = 4
CONST CONTACTS_FOLDER = 5
CONST JOURNAL_FOLDER = 6
CONST NOTES_FOLDER = 7
CONST TASKS_FOLDER = 8
CONST ALL_FOLDERS = 9

'''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Constants for Permission Level
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
CONST OWNER_ACCESS = &h5e3
CONST PUBLISHING_EDITOR_ACCESS = &h4e3
CONST EDITOR_ACCESS = &h463
CONST PUBLISHING_AUTHOR_ACCESS = &h49b
CONST AUTHOR_ACCESS = &h41b
CONST NONEDITING_AUTHOR_ACCESS = &h413
CONST REVIEWER_ACCESS = &h401
CONST CONTRIBUTOR_ACCESS = &h402
CONST NO_ACCESS = &h400

sDelegate = "Tom Jones"
sMailboxOwner = "Jack Johnson"
sEmailServer = "MyServer"
sAccessLevel = OWNER_ACCESS

strProfile = sEmailServer & vbLf & sMailboxOwner

Set oSession = CreateObject("MAPI.Session")
oSession.Logon , , False, True, , True, strProfile

Set oAddrBook = oSession.AddressLists("Global Address List")
Set oDelegate = oAddrBook.AddressEntries.Item(sDelegate)

Set oCalendar = oSession.GetDefaultFolder(CALENDAR_FOLDER)
Set oACLObject = CreateObject("MSExchange.ACLObject")
oACLObject.CDOItem = oCalendar
Set oACEs = oACLObject.ACEs

bDelegateFound = False
For Each ace in oAces
    sTrusteeName = Replace(Replace(GetACLEntryName(oSession, ace.ID), ",", ""), "'", "")
    If LCase(sTrusteeName) = LCase(sDelegate) Then
        ace.Rights = sAccessLevel
        oACLObject.Update
        bDelegateFound = True
        Exit For
    End If
Next

If bDelegateFound = False Then
    Set oNewACE = CreateObject("MSExchange.ACE")
    oNewACE.ID = oDelegate.ID
    oNewACE.Rights = sAccessLevel
    oACEs.Add oNewACE
    oACLObject.Update
End If
oSession.Logoff

WScript.Echo "Completed adding " & sDelegate & " to Inbox permissions for " & sMailboxOwner & "."

Function GetACLEntryName(oSession, sID)
    If sID = "ID_ACL_DEFAULT" Then
        GetACLEntryName = "Default"
    ElseIf sID = "ID_ACL_ANONYMOUS" Then
        GetACLEntryName = "Anonymous"
    Else
        Set tmpEntry = oSession.GetAddressEntry(sID)
        GetACLEntryName = tmpEntry.Name
        Set tmpEntry = Nothing
    End If
End Function

Open in new window

Avatar of LouSch7

ASKER

Your script worked...kind of.

When I ran it I was able to add myself as a delegate to one of my colleagues however, it gave me FULL OWNER ACCESS OF EVERYTHING...his inbox, outbox, calendar, sub folders; everything as opposed to just his calendar.  Also, after having set the permissions I am not able to reset them using the same script and changing the access level which is what I'm looking to be able to do.
If you change this line: sAccessLevel = OWNER_ACCESS then it won't give full access.  As for doing it to all folders, can you post your script?  Did you change anything?  I just tested again and this works for me.  Exch 03 or 07?
Avatar of LouSch7

ASKER

Attached is what I used and we are using Exch 03
<%@ Language=VBScript %>
<!--#include file="inc_header.asp"-->

<%
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Constants for Outlook Folders
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
CONST CALENDAR_FOLDER = 0
CONST INBOX_FOLDER = 1
CONST OUTBOX_FOLDER = 2
CONST SENT_FOLDER = 3
CONST DELETED_FOLDER = 4
CONST CONTACTS_FOLDER = 5
CONST JOURNAL_FOLDER = 6
CONST NOTES_FOLDER = 7
CONST TASKS_FOLDER = 8
CONST ALL_FOLDERS = 9

'''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Constants for Permission Level
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
CONST OWNER_ACCESS = &h5e3
CONST PUBLISHING_EDITOR_ACCESS = &h4e3
CONST EDITOR_ACCESS = &h463
CONST PUBLISHING_AUTHOR_ACCESS = &h49b
CONST AUTHOR_ACCESS = &h41b
CONST NONEDITING_AUTHOR_ACCESS = &h413
CONST REVIEWER_ACCESS = &h401
CONST CONTRIBUTOR_ACCESS = &h402
CONST NO_ACCESS = &h400

sDelegate = "sscharlau"
sMailboxOwner = "mziegler"
sEmailServer = "myserver"
sAccessLevel = EDITOR_ACCESS

strProfile = sEmailServer & vbLf & sMailboxOwner

Set oSession = CreateObject("MAPI.Session")
oSession.Logon , , False, True, , True, strProfile

Set oAddrBook = oSession.AddressLists("Global Address List")
Set oDelegate = oAddrBook.AddressEntries.Item(sDelegate)

Set oCalendar = oSession.GetDefaultFolder(CALENDAR_FOLDER)
Set oACLObject = CreateObject("MSExchange.ACLObject")
oACLObject.CDOItem = oCalendar
Set oACEs = oACLObject.ACEs

bDelegateFound = False
For Each ace in oAces
    sTrusteeName = Replace(Replace(GetACLEntryName(oSession, ace.ID), ",", ""), "'", "")
    If LCase(sTrusteeName) = LCase(sDelegate) Then
        ace.Rights = sAccessLevel
        oACLObject.Update
        bDelegateFound = True
        Exit For
    End If
Next

If bDelegateFound = False Then
    Set oNewACE = CreateObject("MSExchange.ACE")
    oNewACE.ID = oDelegate.ID
    oNewACE.Rights = sAccessLevel
    oACEs.Add oNewACE
    oACLObject.Update
End If
oSession.Logoff

Response.Write "Completed adding " & sDelegate & " to Inbox permissions for " & sMailboxOwner & "."

Function GetACLEntryName(oSession, sID)
    If sID = "ID_ACL_DEFAULT" Then
        GetACLEntryName = "Default"
    ElseIf sID = "ID_ACL_ANONYMOUS" Then
        GetACLEntryName = "Anonymous"
    Else
        Set tmpEntry = oSession.GetAddressEntry(sID)
        GetACLEntryName = tmpEntry.Name
        Set tmpEntry = Nothing
    End If
End Function
%>

Open in new window

Avatar of LouSch7

ASKER

I also went ahead and removed the include at the top of the page, just to make sure nothing from my skin was interfering with the script.  I then switched the sDelegate and sMailboxOwner above, the script ran fine the first time through, but then if I try and run the script a second time with a different sAccessLevel, it fails:

error '800b0003'

/test/members/test.asp, line 64

oACEs.Add oNewACE
Honestly, I'm not sure whats wrong.  I just coped the exact code you have into a file, changed the values for sdelegate, smailboxowner, semailserver and sAccessLevel and was able to add/update several users to various folders.  It didn't write to all folders, only the calendar.  Can you try running as a VBS (just remove the ASP stuff) and see if it is successful?
Avatar of LouSch7

ASKER

Okay, I made it into a .vbs and ran it from the desktop of the server my ASP site is hosted on and received the following:

Line:   61
Char:  5
Error: The form specified for the subject is not one supported or known by the specified trust provider.
Code: 800B0003

Line 61 is oACEs.Add oNewACE
thats the error i saw when the delegate already existed.  Are you login names and display names different?  That might be why.  Try removing all permissions from the calendar then run once.  If that works, I can give you a workaround.
Avatar of LouSch7

ASKER

Okay did that and it worked...kind of...
The alias of the person was attempting to give access to my calendar is 'mziegler' but, it added a person whose alias is 'nbutterazzi'...

Any thoughts?

Also, still doesn't work if I try and run it a second time changing the access level
sorry, for sDelegate try putting in the DisplayName from AD.  For the Owner, use the exchange alias.  If that works for you, let me knw and I can modify so you can just put in the logon name (sAMAccountName) and get the needed fields from AD.
Avatar of LouSch7

ASKER

Bravo...
That works like a champ now.
ASKER CERTIFIED SOLUTION
Avatar of spinzr0
spinzr0
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of LouSch7

ASKER

Here is test.asp
<%@ Language=VBScript %>
<!--#include file="../Includes/app_config.asp" -->
<%
'*******************************************
'*******************************************
'START CALENDAR PERMISSIONS INFORMATION SCRIPTS
'*******************************************
'*******************************************

Set RSSelectedClient = Server.CreateObject("ADODB.Recordset")
Call OPEN_DB	
SQLSelectedClient = "SELECT * FROM tblClient LEFT OUTER JOIN tblClientHostNames ON tblClient.ClientEmplID = tblClientHostNames.ClientEmplID WHERE tblClient.ClientEmplID = '" & 1478 & "'"
Set RSSelectedClient = MyConn.Execute(SQLSelectedClient)


On Error Resume Next
If RSSelectedClient("ClientEmail") Then
	Dim CalendarRights, userDelegate
	Dim strProfileInfo
		
	strServer = "rocmailcluster"
	strMailbox = Trim(Left(RSSelectedClient("ClientEmail"),(inStr(RSSelectedClient("ClientEmail"),"@")-1)))						
	
	Const ForReading = 1
	Const ForAppending = 8
	
	Const  RIGHTS_EDIT_OWN = &h8
	Const  RIGHTS_EDIT_ALL = &h20
	Const  RIGHTS_DELETE_OWN = &h10
	Const  RIGHTS_DELETE_ALL = &h40
	Const  RIGHTS_READ_ITEMS = &h1
	Const  RIGHTS_CREATE_ITEMS = &h2
	Const  RIGHTS_CREATE_SUBFOLDERS = &h80
	Const  RIGHTS_FOLDER_OWNER = &h100
	Const  RIGHTS_FOLDER_CONTACT = &h200
	Const  RIGHTS_FOLDER_VISIBLE = &h400
	Const  RIGHTS_NONE = 0
	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
	
	Const CdoDefaultFolderCalendar = 0	
	Const UDefault = "ID_ACL_DEFAULT"
	Const UAnonymous = "ID_ACL_ANONYMOUS"
	
	
	Set objACLObject = CreateObject("MSExchange.ACLObject")
	
	Set objSession = CreateObject("MAPI.Session") 
	
	strProfileInfo = strServer & vbLf & strMailbox 
	
	objSession.Logon , , False, True, , True, strProfileInfo 
	
	'Get the Default Information store and Calendar Folder
	Set objStore = objSession.GetInfoStore("") 
	Set objFolder = objSession.GetDefaultFolder(CdoDefaultFolderCalendar)
	objACLObject.CDOItem = objFolder
	
	Set objACEs = objACLObject.ACEs
	Set objACEs2 = objACLObject.ACEs
	
	userAceCount = 0
	%>
	<table>
		<form name="EditCalendarPermissions" action="ProcessClientPermissions.asp" method="post">
			<input type="hidden" name="Action" value="EditCalPerms">
			<input type="hidden" name="Owner" value="<%=strMailbox%>">
			<tr>
				<th>User</th>
				<th>Rights</th>
			</tr>
			<%
			For Each userAce in objACEs2
			
				Select Case userAce.ID
					Case UDefault
						userDelegate = "UDefault"
					Case UAnonymous
						userDelegate = "UAnonymous"
					Case Else
						Set TempEntry = objSession.GetAddressEntry(userAce.ID)
						userDelegate = UCase(TempEntry.Name)
				End Select
			
				Select Case userAce.Rights
					case "0"
						CalendarRights = "none"
					case "2043"
						CalendarRights = "OWNER"
					case "1179"
						CalendarRights = "PUBLISHING AUTHOR"
					case "1147"
						CalendarRights = "EDITOR"
					case "1025"
						CalendarRights = "REVIEWER"
					case "1275"
						CalendarRights = "Publishing Editor"
					case "1051"
						CalendarRights = "Author - 1051"
					case "1563"
						CalendarRights = "Author + Folder Contact - 1563"
					Case "1024"
						CalendarRights = "Folder Visible - 1024"
					Case "1026"
						CalendarRights = "CONTRIBUTOR"
					Case "1043"
						CalendarRights = "NONEDITING_AUTHOR - 1043"
					case "1923"
						CalendarRights = "Custom - All Check Boxes - 1923"
					case "1067"
						CalendarRights = "Custom - Create,Read,Visible + Edit:all,Del:none - 1067"
					case "1035"
						CalendarRights = "Custom - Create,Read,Visible + Edit:own,Del:none - 1035"
					Case else
						CalendarRights = "??custom?? - " & userAce.Rights
				End Select
				
				strDelegate = format_ucase(lcase(userDelegate))
					If inStr(strDelegate ,"Udefault") Then strDelegate = "" Else strDelegate = strDelegate End If
					If inStr(strDelegate ,"Uanonymous") Then strDelegate = "" Else strDelegate = strDelegate End If
				
				strRights = format_ucase(lcase(CalendarRights))
				
				
				strText = format_ucase(lcase(userDelegate)) & " - " & format_ucase(lcase(CalendarRights)) & "<br/>"
				If inStr(strText,"Udefault") Then 
					strText = "" 
					userAceCount = userAceCount - 1
				Else 
					strText = strText 
				End If
				If inStr(strText,"Uanonymous") Then 
					strText = "" 
					userAceCount = userAceCount - 1
				Else 
					strText = strText 
				End If
				If Len(strText) > 10 Then %>
					<tr>
						<td>
							<input type="hidden" name="Delegate<%=userAceCount%>" value="<%=strDelegate%>">
							<%=strDelegate%>
						</td>
						<td>							
							<select name="Rights<%=userAceCount%>">
								<option value="2043" <% If Trim(userAce.Rights) = "2043" OR Trim(userAce.Rights) = "1923" Then Response.Write "selected" End If%>>Owner</option>
								<option value="1275" <% If Trim(userAce.Rights) = "1275" Then Response.Write "selected" End If%>>Publishing Editor</option>
								<option value="1147" <% If Trim(userAce.Rights) = "1147" Then Response.Write "selected" End If%>>Editor</option>
								<option value="1179" <% If Trim(userAce.Rights) = "1179" OR Trim(userAce.Rights) = "1067" OR Trim(userAce.Rights) = "1035" Then Response.Write "selected" End If%>>Publishing Author</option>								
								<option value="1051" <% If Trim(userAce.Rights = "1051") OR Trim(userAce.Rights) = "1536" Then Response.Write "selected" End If %>>Author</option>
								<option value="1043" <% If Trim(userAce.Rights) = "1043" Then Response.Write "selected" End If%>>Non Editing Author</option>
								<option value="1025" <% If Trim(userAce.Rights) = "1025" Then Response.Write "selected" End If%>>Reviewer</option>								
								<option value="1026" <% If Trim(userAce.Rights) = "1026" Then Response.Write "selected" End If%>>Contributor</option>
								<option value="0" <% If Trim(userAce.Rights) = "0" OR Trim(userAce.Rights) = "1024" Then Response.Write "selected" End If%>>None</option>
							</select>
						</td>
					</tr>
				<%
				End If		
				userAceCount = userAceCount + 1		
			Next %>
			<tr>
				<td colspan="2">
					<input type="hidden" name="userAceCount" value="<%=userAceCount%>">
					<input type="submit" value="Update Rights">
				</td>
			</tr>
		</form>
	</table>
	<%
End If
'*******************************************
'*******************************************
'END CALENDAR PERMISSIONS INFORMATION SCRIPTS
'*******************************************
'*******************************************
%>

Open in new window

Avatar of LouSch7

ASKER

Here is test2.asp
<%@ Language=VBScript %>
<!--#include file="inc_header.asp"-->

<%
Action = ProtectSQL(Trim(Request.Form("Action")))
If Action = "" Then
	Response.Redirect "default.asp"
Else
	
	'*******************************************
	'*******************************************
	'START USER/FORM BASED VARIABLES
	'*******************************************
	'*******************************************
		userAceCount = ProtectSQL(Trim(Request.Form("userAceCount")))
		sEmailServer = "rocmailcluster"
		sMailboxOwner = ProtectSQL(Trim(Request.Form("Owner")))
		Client = ProtectSQL(Trim(Request.Form("Client")))
	'*******************************************
	'*******************************************
	'END USER/FORM BASED VARIABLES
	'*******************************************
	'*******************************************
	
	'*******************************************
	'*******************************************
	'START CONSTANTS FOR OUTLOOK FOLDERS
	'*******************************************
	'*******************************************
		CONST CALENDAR_FOLDER = 0
		CONST INBOX_FOLDER = 1
		CONST OUTBOX_FOLDER = 2
		CONST SENT_FOLDER = 3
		CONST DELETED_FOLDER = 4
		CONST CONTACTS_FOLDER = 5
		CONST JOURNAL_FOLDER = 6
		CONST NOTES_FOLDER = 7
		CONST TASKS_FOLDER = 8
		CONST ALL_FOLDERS = 9
	'*******************************************
	'*******************************************
	'END CONSTANTS FOR OUTLOOK FOLDERS
	'*******************************************
	'*******************************************
	
	'*******************************************
	'*******************************************
	'START CONSTANTS FOR PERMISSION LEVEL
	'*******************************************
	'*******************************************
		CONST OWNER_ACCESS = &h5e3
		CONST PUBLISHING_EDITOR_ACCESS = &h4e3
		CONST EDITOR_ACCESS = &h463
		CONST PUBLISHING_AUTHOR_ACCESS = &h49b
		CONST AUTHOR_ACCESS = &h41b
		CONST NONEDITING_AUTHOR_ACCESS = &h413
		CONST REVIEWER_ACCESS = &h401
		CONST CONTRIBUTOR_ACCESS = &h402
		CONST NO_ACCESS = &h400
	'*******************************************
	'*******************************************
	'END CONSTANTS FOR PERMISSION LEVEL
	'*******************************************
	'*******************************************
	
	'*******************************************
	'*******************************************
	'START PROCESSING OF PERMISSION CHANGES
	'*******************************************
	'*******************************************
	
	Function GetACLEntryName(oSession, sID)
	    If sID = "ID_ACL_DEFAULT" Then
	        GetACLEntryName = "Default"
	    ElseIf sID = "ID_ACL_ANONYMOUS" Then
	        GetACLEntryName = "Anonymous"
	    Else
	        Set tmpEntry = oSession.GetAddressEntry(sID)
	        GetACLEntryName = tmpEntry.Name
	        Set tmpEntry = Nothing
	    End If
	End Function		
	
	For i=0 to userAceCount - 1
		sDelegate = ProtectSQL(Trim(Request.Form("Delegate" & i)))
		sRights = ProtectSQL(Trim(Request.Form("Rights" & i)))	
		
		Select Case sRights
			case "0"
				CalendarRights = NO_ACCESS
			case "2043"
				CalendarRights = OWNER_ACCESS
			case "1179"
				CalendarRights = PUBLISHING_AUTHOR_ACCESS
			case "1147"
				CalendarRights = EDITOR_ACCESS
			case "1025"
				CalendarRights = REVIEWER_ACCESS
			case "1275"
				CalendarRights = PUBLISHING_EDITOR_ACCESS
			case "1051"
				CalendarRights = AUTHOR_ACCESS
			case "1563"
				CalendarRights = AUTHOR_ACCESS
			Case "1024"
				CalendarRights = NO_ACCESS
			Case "1026"
				CalendarRights = CONTRIBUTOR_ACCESS
			Case "1043"
				CalendarRights = NONEDITING_AUTHOR_ACCESS
			case "1923"
				CalendarRights = OWNER_ACCESS
			case "1067"
				CalendarRights = PUBLISHING_AUTHOR_ACCESS
			case "1035"
				CalendarRights = PUBLISHING_AUTHOR_ACCESS
			Case else
				CalendarRights = NO_ACCESS
		End Select
		
		sAccessLevel = CalendarRights
		
		strProfile = sEmailServer & vbLf & sMailboxOwner
		
		Set oSession = CreateObject("MAPI.Session")
		oSession.Logon , , False, True, , True, strProfile
		
		Set oAddrBook = oSession.AddressLists("Global Address List")
		Set oDelegate = oAddrBook.AddressEntries.Item(sDelegate)
		
		Set oCalendar = oSession.GetDefaultFolder(CALENDAR_FOLDER)
		Set oACLObject = CreateObject("MSExchange.ACLObject")
		oACLObject.CDOItem = oCalendar
		Set oACEs = oACLObject.ACEs
		
		bDelegateFound = False
		For Each ace in oAces
		    sTrusteeName = Replace(Replace(GetACLEntryName(oSession, ace.ID), ",", ""), "'", "")
		    If LCase(sTrusteeName) = LCase(sDelegate) Then
		        ace.Rights = sAccessLevel
		        oACLObject.Update
		        bDelegateFound = True
		        Exit For
		    End If
		Next
		
		If bDelegateFound = False Then
		    Set oNewACE = CreateObject("MSExchange.ACE")
		    oNewACE.ID = oDelegate.ID
		    oNewACE.Rights = sAccessLevel
		    oACEs.Add oNewACE
		    oACLObject.Update
		End If
		oSession.Logoff		
	Next
	Response.Redirect "test2.asp?Client=" & Client
End If
%>

Open in new window

Avatar of LouSch7

ASKER

Together they allow me to dynamically select a user, display all individuals who have rights to said users calendar and interactively change those rights from the same screen...

My next step will be to provide a solution to add a new person to the calendar permissions.

I'm also going to try and see if there is a way to completely delete the user from the permissions instead of simply setting to None however, that is for another question.
Avatar of LouSch7

ASKER

Thank you very much for all of you help, your input was instrumental in making this work.