Go Premium for a chance to win a PS4. Enter to Win

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 796
  • Last Modified:

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

0
LouSch7
Asked:
LouSch7
  • 13
  • 9
1 Solution
 
icfireCommented:
This might be better posted in a VB or VBscript zone.
0
 
LouSch7Author Commented:
Is there a way to change the zone?
0
 
spinzr0Commented:
Here is a script that does it for the inbox.  Just modify for calendar.

http://www.eggheadcafe.com/forumarchives/scriptingVisualBasicscript/Jul2005/post23377729.asp
0
Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

 
spinzr0Commented:
Please let me know if that link isn't helpful.
0
 
LouSch7Author Commented:
It seems helpful I'm just trying to figure out how I'm going to modify it for calendar permissions instead.
0
 
LouSch7Author Commented:
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

0
 
spinzr0Commented:
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.
0
 
spinzr0Commented:
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

0
 
LouSch7Author Commented:
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.
0
 
spinzr0Commented:
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?
0
 
LouSch7Author Commented:
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

0
 
LouSch7Author Commented:
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
0
 
spinzr0Commented:
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?
0
 
LouSch7Author Commented:
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
0
 
spinzr0Commented:
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.
0
 
LouSch7Author Commented:
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
0
 
spinzr0Commented:
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.
0
 
LouSch7Author Commented:
Bravo...
That works like a champ now.
0
 
spinzr0Commented:
Ok, then here is a modification.  This way, you can put in the sAMAccountName (Pre win2000 logon name) for both accounts and it does the work for you.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 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

sDomain = "mydomain" 'no period, so mydomain.com would be mydomaincom
sDelegate = "LogonName"
sMailboxOwner = "LogonName"
sEmailServer = "myserver"
sAccessLevel = PUBLISHING_EDITOR_ACCESS

sDelegateDisplayName = GetADAttribute(sDelegate, "DisplayName")
sOwnerExchangeAlias = GetADAttribute(sMailboxOwner, "mailNickname")

sProfile = sEmailServer & vbLf & sOwnerExchangeAlias
Set oSession = CreateObject("MAPI.Session")
oSession.Logon , , False, True, , True, sProfile

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

Set oACEs = Nothing
Set oACLObject = Nothing
Set oCalendar = Nothing
Set oDelegate = Nothing
Set oAddrBook = Nothing
Set oSession = Nothing

Msgbox "Completed adding " & sDelegate & " to calendar 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

Function GetADAttribute(sAccountName, sAttribute)
    On Error Resume Next
    
    Const ADS_NAME_INITTYPE_GC = 3
    Const ADS_NAME_TYPE_NT4 = 3
    Const ADS_NAME_TYPE_1779 = 1
    
    Set oTranslate = CreateObject("NameTranslate")
    oTranslate.Init ADS_NAME_INITTYPE_GC, ""
    oTranslate.Set ADS_NAME_TYPE_NT4, sDomain & "\" & sAccountName
    
    If Err.Number <> 0 Then
        Msgbox "User not found: " & sAccountName
        Wscript.Quit
    Else
        Set oUser = GetObject("LDAP://" & oTranslate.Get(ADS_NAME_TYPE_1779))
        If Err.Number <> 0 Then
            Msgbox "User not found: " & sAccountName
            Wscript.Quit
        Else
            If sAttribute = "DisplayName" Then
                GetADAttribute = oUser.DisplayName
            ElseIf sAttribute = "mailNickname" Then
                GetADAttribute = oUser.mailNickname
            Else
                Msgbox "Unknown Attribute: " & sAttribute
                Wscript.Quit
            End If
        End If
    End If
    Set oUser = Nothing
    Set oTranslate = Nothing
End Function

Open in new window

0
 
LouSch7Author Commented:
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

0
 
LouSch7Author Commented:
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

0
 
LouSch7Author Commented:
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.
0
 
LouSch7Author Commented:
Thank you very much for all of you help, your input was instrumental in making this work.
0

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

  • 13
  • 9
Tackle projects and never again get stuck behind a technical roadblock.
Join Now