HOW TO:Set folder level permissions using CDO 1.21 and ACL.dll

Artikel
11/07/2008

This is not something everyone would want to do, but just in case below is the sample code that uses ACL.dll (found in the Platform SDK) to set "Reviewer" permissions on all the folders for a specific user.

The following sample is a simple VBScript code sample that iterates through all folders in multiple mailboxes and sets the "Reviewer" permissions. To use this sample, paste the following code in a new text file, and then name the file SetFolderPermissions.vbs:

 'This script logs on to a server that is running Exchange Server and iterates through all the mailboxes
'recursively setting the "Reviewer" permission on each folder for a specific user.

' USAGE: cscript SetFolderPermissions.vbs SERVERNAME DATAFILE FullUserName
' This requires that CDO 1.21 and the Acl.dll is installed on the computer.

Dim obArgs
Dim cArgs
Dim objSession
Dim objInfoStores
Dim FullUserName

Set obArgs = WScript.Arguments
cArgs = obArgs.Count

Const CdoMsg = 3,ForReading = 1, ForWriting = 2, ForAppending = 8, TristateFalse = 0

Main

Sub Main()
Dim FileSysObj
Dim DataFileName
Dim DataFile
Dim alias

    If cArgs <> 3 Then
        WScript.Echo "Usage: cscript SetFolderPermissions.vbs SERVERNAME DATAFILE(Name and Path) FullUserName"
        Exit Sub
    End If

    Set FileSysObj = CreateObject("Scripting.FileSystemObject")

    DataFileName = obArgs.Item(1)
    FullUserName = obArgs.Item(2)


    Set DataFile = FileSysObj.OpenTextFile(DataFileName, ForReading, False,0)
    
    'Read line by line
    Do While Not DataFile.AtEndOfStream
         alias = DataFile.ReadLine
    
    'Loop through the mailboxes
        Call IterateInfoStores(obArgs.Item(0), alias)
    Loop
   
    DataFile.Close

    'Clean Up    
    Set DataFile = Nothing
    Set FileSysObj = Nothing

End Sub


Sub IterateInfoStores(ServerName,UserName)

Dim objFolder
Dim intCounter
Dim objInfoStore
Dim sMsg

    On Error Resume Next
    
    'Create the new Session Object
    Set objSession = CreateObject("MAPI.Session")

    If Err.Number <> 0 Then
      sMsg = "Error creating MAPI.Session."
      sMsg = sMsg & "Make sure CDO 1.21 is installed. "
      sMsg = sMsg & Err.Number & " " & Err.Description
      WScript.Echo sMsg
      Exit Sub
    End If

    'Logon to the Mailbox
    objSession.Logon "", "", False, True, 0, False, ServerName & vbLf & UserName
    
    If Err.Number <> 0 Then
      sMsg = "Error logging on: "
      sMsg = sMsg & Err.Number & " " & Err.Description
      WScript.Echo sMsg
      WScript.Echo "Server: " & ServerName
      WScript.Echo "Mailbox: " & UserName
      Set objSession = Nothing
      Exit Sub
    End If

    WScript.Echo "Logged On to:" & objSession.CurrentUser

    'Loop through the Infostores
    For intCounter = 1 To objSession.InfoStores.Count
        Set objInfoStore = objSession.InfoStores(intCounter)

    If Err.Number <> 0 Then
          sMsg = "Error retrieving InfoStore Object: "
          sMsg = sMsg & Err.Number & " " & Err.Description
          WScript.Echo sMsg
          WScript.Echo "Server: " & ServerName
          WScript.Echo "Mailbox: " & UserName
          Set objInfoStore = Nothing
          Set objSession = Nothing
          Exit Sub
    End If
    
        If objInfoStore.Name = "Mailbox - " & objSession.CurrentUser Then
            Exit For
        End If
    Next
    
    Set objFolder = objInfoStore.RootFolder
    
    If Err.Number <> 0 Then
    sMsg = "Error retrieving RootFolder Object: "
    sMsg = sMsg & Err.Number & " " & Err.Description
    WScript.Echo sMsg
    WScript.Echo "Server: " & ServerName
    WScript.Echo "Mailbox: " & UserName
    Set objInfoStore = Nothing
    Set objFolder = Nothing
    Set objSession = Nothing
    Exit Sub
    End If

    'Recurse through the sub-folders
    NavigateFolders objFolder

    If Err.Number <> 0 Then
    sMsg = "Error: "
    sMsg = sMsg & Err.Number & " " & Err.Description
    WScript.Echo sMsg
    WScript.Echo "Server: " & ServerName
    WScript.Echo "Mailbox: " & UserName
    End If
    
    'Logoff from the session
    objSession.Logoff

    'Clean Up
    Set objFolder = Nothing
    Set objInfoStore = Nothing
    Set objSession = Nothing
End Sub

Sub NavigateFolders(MAPIFolder)
Dim intCounter
Dim oDelegate
Dim oAddrBook
Dim oNewAce
Dim ACLObj
Dim FolderACEs
Dim objAce

Const ROLE_REVIEWER = &H401
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_CONTRIBUTOR = &H402 
Const ROLE_NONE = &H400 


    WScript.Echo "Folder Name:" & MAPIFolder.Name

    'Create the ACL object
    Set ACLObj = CreateObject("MSExchange.aclobject")
    
    ' Associate the ACLObject to the CDO Folder
    ACLObj.CDOItem = MAPIFolder
    Set FolderACEs = ACLObj.ACEs

    ' Create a MAPI object for UserA
    Set oAddrBook = objSession.AddressLists("Global Address List")

    Set oDelegate = oAddrBook.AddressEntries.Item(FullUserName)

    Set oNewAce = CreateObject("MSExchange.ACE")

    oNewAce.ID = oDelegate.ID
    oNewAce.Rights = ROLE_REVIEWER
    FolderACEs.Add oNewAce
    ACLObj.Update

    ' Loop through all of the ACEs for the folder and display them
    For each objAce in  FolderACEs
    WScript.Echo GetACLEntryName(objAce.ID) & " - " & DispACERules(objAce)
    Next
    WScript.Echo ""

    ' Clean up objects
    Set objAce = Nothing
    Set oNewAce = Nothing
    Set FolderACEs = Nothing
    Set ACLObj = Nothing

    If MAPIFolder.Folders.Count > 0 Then
        For intCounter = 1 To MAPIFolder.Folders.Count
            NavigateFolders MAPIFolder.Folders(intCounter)
        Next
    End If


End Sub

Function GetACLEntryName(ACLEntryID)
On Error resume Next
' This function finds the user that is listed as an ACE on the folder.
' It takes the ID that it is passed and uses the Session.GetAddressEntry method
' to find the name.
    
    Dim tmpEntry
    Dim tmpName

    Select Case ACLEntryID
    Case "ID_ACL_DEFAULT"
            GetACLEntryName = "Default"
    Case "ID_ACL_ANONYMOUS"
            GetACLEntryName = "Anonymous"
    Case else
       ' Get the name of the ACE
        Set tmpEntry = objSession.GetAddressEntry(ACLEntryID)
            tmpName = tmpEntry.Name
            GetACLEntryName = tmpName
    End Select
    
End Function

Function DispACERules(DisptmpACE)
' This function checks the roles of the ACE that is passed to it and    returns
' the Role back.
Const ROLE_NONE = 1024
Const ROLE_AUTHOR = 1051
Const ROLE_CONTRIBUTOR = 1026
Const ROLE_PUBLISH_AUTHOR = 1179
Const ROLE_NONEDITING_AUTHOR = 1043
Const ROLE_REVIEWER = 1025
Const ROLE_EDITOR = 1147
Const ROLE_OWNER = 2043
Const ROLE_PUBLISH_EDITOR = 1275  

    ' Check the roles on the folder
    Select Case DisptmpACE.Rights
        Case ROLE_NONE, 0  ' Checking in case the role has not been set on that entry.
                DispACERules = "None"
        Case ROLE_AUTHOR
                DispACERules = "Author"
        Case ROLE_CONTRIBUTOR
                DispACERules = "Contributor"
        Case ROLE_EDITOR
                DispACERules = "Editor"
        Case ROLE_NONEDITING_AUTHOR
                DispACERules = "Nonediting Author"
        Case ROLE_OWNER
                DispACERules = "Owner"
        Case ROLE_PUBLISH_AUTHOR
                DispACERules = "Publishing Author"
        Case ROLE_PUBLISH_EDITOR
                DispACERules = "Publishing Editor"
        Case ROLE_REVIEWER
                DispACERules = "Reviewer"
        Case Else
        ' This will grab all other custom permissions on the folder
                DispACERules = "Custom"
    End Select

End Function

The list of mailboxes can be provided via a text file(Datafile). The Datafile contains the aliases of the users(one on each line). So assuming your Datafile is called "Aliases.txt" and is on the C:\, you would run the script as follows:

C:\>Cscript SetFolderPermissions.vbs Exchange2003 C:\Aliases.txt "Akash Bhargava"

The script currently sets and also dumps out the permissions on each folder in the mailbox.

The account that you are logged on the computer with must have permissions on the mailboxes that you are trying to iterate through. You can give the permissions by following the steps in the article below:

How to assign service account access to all mailboxes in Exchange Server 2003

https://support.microsoft.com/kb/821897/

Enjoy!

Comments

Anonymous
February 10, 2009
Hi,Would this work with both Exchange 2003 and Exchange 2007 mailboxes?Regards,-Jim
Anonymous
February 10, 2009
This works on Exchange 2003 for sure. I have not tested it on Exchange 2007.
Anonymous
September 02, 2009
hi,i am still receiving 'mapi_e_not_found' failure, permission of local account has been set to full rights in ESM ?please help
Anonymous
September 02, 2009
The comment has been removed
Anonymous
September 02, 2009
it happens here:'Recurse through the sub-folders NavigateFolders objFolder If Err.Number <> 0 Then sMsg = "Error: " sMsg = sMsg & Err.Number & " " & Err.Description WScript.Echo sMsg WScript.Echo "Server: " & ServerName WScript.Echo "Mailbox: " & UserName End Ifi am receiving the error on all mailboxes. also tried to create new mailboxes on different exchange server and information store,no effect.
Anonymous
September 02, 2009
The comment has been removed
Anonymous
September 03, 2009
The comment has been removed
Anonymous
September 04, 2009
The comment has been removed
Anonymous
September 04, 2009
The comment has been removed

Delen via

HOW TO:Set folder level permissions using CDO 1.21 and ACL.dll

Comments

Aanvullende resources