Solved

Modify Calendar Permissions using VB in ASP Classic

Posted on 2010-09-20
25
780 Views
Last Modified: 2013-12-25
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
Comment
Question by:LouSch7
  • 13
  • 9
25 Comments
 
LVL 2

Expert Comment

by:icfire
ID: 33718316
This might be better posted in a VB or VBscript zone.
0
 
LVL 3

Author Comment

by:LouSch7
ID: 33718337
Is there a way to change the zone?
0
 
LVL 8

Expert Comment

by:spinzr0
ID: 33722155
Here is a script that does it for the inbox.  Just modify for calendar.

http://www.eggheadcafe.com/forumarchives/scriptingVisualBasicscript/Jul2005/post23377729.asp
0
 
LVL 8

Expert Comment

by:spinzr0
ID: 33727810
Please let me know if that link isn't helpful.
0
 
LVL 3

Author Comment

by:LouSch7
ID: 33728105
It seems helpful I'm just trying to figure out how I'm going to modify it for calendar permissions instead.
0
 
LVL 3

Author Comment

by:LouSch7
ID: 33734948
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
 
LVL 8

Expert Comment

by:spinzr0
ID: 33738815
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
 
LVL 8

Expert Comment

by:spinzr0
ID: 33738922
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
 
LVL 3

Author Comment

by:LouSch7
ID: 33744303
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
 
LVL 8

Expert Comment

by:spinzr0
ID: 33744398
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
 
LVL 3

Author Comment

by:LouSch7
ID: 33744491
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
IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 
LVL 3

Author Comment

by:LouSch7
ID: 33744691
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
 
LVL 8

Expert Comment

by:spinzr0
ID: 33744895
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
 
LVL 3

Author Comment

by:LouSch7
ID: 33746320
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
 
LVL 8

Expert Comment

by:spinzr0
ID: 33746361
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
 
LVL 3

Author Comment

by:LouSch7
ID: 33747011
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
 
LVL 8

Expert Comment

by:spinzr0
ID: 33758107
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
 
LVL 3

Author Comment

by:LouSch7
ID: 33761156
Bravo...
That works like a champ now.
0
 
LVL 8

Accepted Solution

by:
spinzr0 earned 500 total points
ID: 33762517
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
 
LVL 3

Author Comment

by:LouSch7
ID: 33778734
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
 
LVL 3

Author Comment

by:LouSch7
ID: 33778753
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
 
LVL 3

Author Comment

by:LouSch7
ID: 33778770
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
 
LVL 3

Author Closing Comment

by:LouSch7
ID: 33778777
Thank you very much for all of you help, your input was instrumental in making this work.
0

Featured Post

Find Ransomware Secrets With All-Source Analysis

Ransomware has become a major concern for organizations; its prevalence has grown due to past successes achieved by threat actors. While each ransomware variant is different, we’ve seen some common tactics and trends used among the authors of the malware.

Join & Write a Comment

Introduction While answering a recent question (http://www.experts-exchange.com/Q_27402310.html) in the VB classic zone, I wrote some VB code in the (Office) VBA environment, rather than fire up my older PC.  I didn't post completely correct code o…
The debugging module of the VB 6 IDE can be accessed by way of the Debug menu item. That menu item can normally be found in the IDE's main menu line as shown in this picture.   There is also a companion Debug Toolbar that looks like the followin…
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…

758 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

23 Experts available now in Live!

Get 1:1 Help Now