none
[E2010][CDOEX][VBSCRIPT]: Problem linking ACL object to calendar folder RRS feed

  • Question

  • I'm trying to get some scripts to work with our new E2010 environment (I know this isn't the preferred method).  The script I'm working on updates calendar permissions for everyone in the organization.  The script worked fine up until we switched to 2010.  The script works fine while looping through users until it hits a certain limit and then it starts failing with (MAPI 1.0 - [E_OUTOFMEMORY(8007000E)]).  I started commenting out code to troubleshoot where the problem starts.  I've narrowed it down to where the script links the ACL object with the calendar folder.  If that line is commented out, I make it through the entire list of users with no problem and the script memory usage doesn't get too large.  If that line of code runs, I get about 2/3 of the way through the list of users (almost 1000) and then start getting the error above.  The script also uses MUCH more memory and keeps growing.  I thought it might be that the memory wasn't being cleaned up, but I can't see where that might be.  The script is here:

    '----------------------------------------------------------------------------' 
    ' Filename:       CalendarPermissions.vbs                                    '
    ' Description:    Sets reviewer permissions on each users calendar           '
    ' Requirements:   The file ACL.DLL must be present and registered.  You must '
    '                 also run this script as a user with permissions to access  '
    '                 all of the mailboxes.                                      '
    ' Last Modified:  8/30/2011 - added support for Exchange 2010  KDB                                                '
    '----------------------------------------------------------------------------' 
    option explicit
    msgbox "Script starting"
    on error resume next
    Dim objFSO                                   ' File System Object
    Dim objTextLog                               ' Log file
    Dim con                                      ' ADODB connection object
    Dim Com                                      ' ADODB command object
    Dim rs                                       ' record set
    Dim varRecord                                ' individual users of the exclusion list
    Dim varBOF                                   ' 0/1 value used to determine if the pointer is at the first record
    Dim UserExclusions                           ' string dynamically created used in the user query
    Dim AceExists                                ' 0/1 value used to determine if the user permissions exists or not
    Dim MailUser                                 ' user whos calendar permissions will be edited
    Dim oSession                                 ' Session object
    Dim oCalendar                                ' Folder object
    Dim oAddrBook                                ' Address list
    Dim oDelegate                                ' Address entry for ReviewerUser
    Dim oACLObject                               ' ACL object
    Dim oACEs                                    ' ACEs collection
    Dim oNewACE                                  ' ACE object
    Dim strProfile                               ' String to hold profile information
    Dim AceObject                                ' individual ACEs with permissions on the users calendar
    Dim UserCount                                ' counter to count how many users where returned
    Dim rscount
    Dim Logging
    Dim PerformUpdate
    Dim AceName
    
    CONST fsoForAppend = 8                       ' used to set the log file open mode 
    CONST ADS_SCOPE_SUBTREE = 2                  ' used for the active directory search scope
    CONST ADSPATH = "GC://DC=inin,DC=com"        ' used for the active directory connection string
    CONST EXC= "calendar Permissions Exceptions" ' used to specify which dist. list contains the excluded users					
    CONST REVIEWERUSER = "All Employees"         ' used to set the group you want to give permissions to
    CONST DEF_CAL = 0                            ' used to set the pointer to the users default outlook calendar
    CONST ROLE_REVIEWER = &h401                  ' used to set the reviewer permissions
    
    rscount = 0                                  ' used to get a count of the number of distribution lists returned
    usercount = 0                                ' used to count how many users where returned
    varBOF = 1                                   ' used mark if the pointer for the dist list members is at the beginning
    Logging = 1                                  ' 0 = summary logging    1 = debug logging
    PerformUpdate = 0                            ' 0 = do not update calendar permissions   1 = update calendar permissions
    
    '-------------------------------------------------------------------------------------
    'Set up the connection to the filesystem and write the first few lines of the log file
    '-------------------------------------------------------------------------------------
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objTextLog = objFSO.OpenTextFile("c:\scripts\calendarpermissions\Calendarpermissions_test.txt", fsoForAppend, True)
    objTextLog.WriteLine "--------------------------------------------------"
    objTextLog.WriteLine Now & "  The Calendar Permissions script is starting..."
    
    '-------------------------------------------------------
    'Setup the Active Directory connection and search string
    '-------------------------------------------------------
    Set con = CreateObject("ADODB.Connection")
    Set Com = CreateObject("ADODB.Command") 
    con.Provider = "ADsDSOObject"
    con.Open "Active Directory Provider"
    Set Com.ActiveConnection = con   
        
    '------------------------------
    'Set the preferences for Search
    '------------------------------
    Com.Properties("Page Size") = 100
    Com.Properties("Timeout") = 30 'seconds
    Com.Properties("searchscope") = ADS_SCOPE_SUBTREE 'Define in ADS_SCOPEENUM
    Com.Properties("Cache Results") = False ' do not cache the result, it results in less memory requirements
    
    '------------------------------------------------------------------------------------------
    'Retrieve the exclusion distribution list and build the exclusion portion of the user query
    '------------------------------------------------------------------------------------------
    Com.CommandText = "select name, member from '" & ADSPATH & "' where name='" & EXC & "' "
    Set rs = Com.Execute       
    For Each varRecord in rs.Fields("member").Value
      If varBOF = 0 Then
        UserExclusions = UserExclusions & " AND "
      End If
      UserExclusions = UserExclusions & "DistinguishedName <> '" & varRecord & "'"
      varBOF = 0
    Next
    wlog("Excluded user search string:   " & UserExclusions)
    
    '-------------------------------------------------------------------------------------
    'Error checking to ensure ONLY one distribution list was returned from the above query
    '-------------------------------------------------------------------------------------
    If rs.recordcount <> 1 Then
      objTextLog.WriteLine Now & "  **ERROR**  " & rs.recordcount & " matching distribution lists were returned!"
    Else
    
      '-----------------------------------------------------
      'Retrieve all users from AD except the exclusion users 
      '-----------------------------------------------------
      Com.CommandText = "select distinguishedname, displayName from '" & ADSPATH & "' where objectcategory='person' AND objectclass='user' AND (" & UserExclusions & ") AND homeMDB = '*' AND msExchHideFromAddressLists <> TRUE AND (company='*Intelligence*' OR company='*Vonexus*') order by name "
      Set rs = Com.Execute
      'numrecs = 0
      while NOT rs.EOF
        Err.Clear
        if err.number <> 0 then
            msgbox "NOTE - the error did not reset!"
        end if
        AceExists = 0                                                 ' Reset the value back to off/false/0
        
    
        MailUser = rs.Fields("displayName").Value                     ' User whose mailbox will be edited
        wlog("Opening mailbox for " & MailUser)
    	
        Set oSession = CreateObject("MAPI.Session")                   ' Create a new session and log on
    
        strProfile = "mail.inin.com" & vbLf & MailUser                ' set up a dynamic profile to connect to the user mailbox
        oSession.Logon , , False, False, , True, strProfile            ' logon to the profile    	
    
        Set oAddrBook = oSession.AddressLists("Global Address List")  ' connect to the GAL
    
        Set oDelegate = oAddrBook.AddressEntries.Item(REVIEWERUSER)   ' Get the address entry for the user   
    
        Set oCalendar = oSession.GetDefaultFolder(DEF_CAL)            ' get the users calendar folder
    
        'wlog("oDelegate.ID = " & oDelegate.ID)
    
        if err.number<>0 then
           objTextLog.WriteLine Now & "  " & "*** ERROR logging on to mailbox for user " & MailUser & " " & Err.Number & " " & Err.Description
           Err.Clear
        else
    
           Set oACLObject = CreateObject("MSExchange.ACLObject")         ' create a new ACL Object
           'oACLObject.CDOItem = oCalendar                                ' link the ACL object to the calendar folder   OFFENDING LINE
           'Set oACEs = oACLObject.ACEs                                   ' get the ACEs collection for the calendar
           wlog("mailbox open")      
    
           '--------------------------------------------------------------------
           '  Check each ACE in the collection to see if the specific ACE exists
           '--------------------------------------------------------------------
           'For each AceObject in oACEs 
           '  Select Case AceObject.ID
           '    Case "ID_ACL_DEFAULT"
           '      AceName = "Default"
      '	   Case "ID_ACL_ANONYMOUS"
      '  	     AceName = "Anonymous"
      '         Case else
      '     	     AceName = oSession.GetAddressEntry(AceObject.ID)  	  
      '       end select
            ' wlog("AceObject.ID = " & AceObject.ID)
      '       wlog("AceName = " & AceName)
      
             '-----------------------------------------------------------------
             '  If the ACE exists in the collection force it to reviewer rights 
             '-----------------------------------------------------------------
             'If AceName = REVIEWERUSER Then
             '  Err.Clear        
             '  wlog(MailUser & " - updating existing entry")
             '  if PerformUpdate = 1 then
             '     AceObject.Rights = ROLE_REVIEWER
             '     oAcLObject.Update
             '  end if
             '  AceExists = 1
    	 '  userCount = UserCount + 1
             'end if
    
    '       Next
     '      wlog("AceExists = "& AceExists)
           '---------------------------------------------------------------------------------
           ' If the ACE does not exist in the collection add it and set it to reviewer rights
           '---------------------------------------------------------------------------------
           'If AceExists = 0 Then
           '  if PerformUpdate = 1 then
           '     Set oNewACE = CreateObject("MSExchange.ACE")
           '     oNewACE.ID = oDelegate.ID
           '     oNewACE.Rights = ROLE_REVIEWER
           '     oACEs.Add oNewACE
           '     oACLObject.Update
           '  end if
           '  wlog(MailUser & " - adding new entry")
           '  UserCount = UserCount + 1
           'end if
        
       end if
        oSession.Logoff   'log off the MAPI profile
        Set oSession = Nothing
        Set oDelegate = Nothing
        Set oAddrBook = Nothing
        Set oCalendar = Nothing
        Set oACLObject = Nothing
        Set oACEs = Nothing
        Set Mailuser = Nothing
        Err.Clear
    
        'numrecs = numrecs + 1
        'wlog("number of records " & numrecs)
    
        rs.MoveNext       'Move to the next record retrieved from Active Directory              
      wend
    
    end if                ' error checking - record count
    
    msgbox "script ending"
    
    '-------------------------------------------------------------------------------     
    ' Write a few lines to the log file, close open connections, and clean up memory
    '-------------------------------------------------------------------------------
    objTextLog.WriteLine Now & "  Total non excluded users = " & UserCount
    objTextLog.WriteLine Now & "  The Calendar Permissions script has ended"
    objTextLog.WriteLine "--------------------------------------------------"
    Set oNewACE = Nothing
    Set oACEs = Nothing
    Set oACLObject = Nothing
    Set oDelegate = Nothing
    Set oAddrBook = Nothing
    Set oCalendar = Nothing
    Set oSession = Nothing
    objTextLog.Close
    Set objTextLog = Nothing
    Set objFSO = Nothing
    Set rs = nothing
    
    
    '------------------'
    'subs and functions'
    '------------------'
    sub wLog(str)
       if logging = 1 then
          objTextLog.WriteLine Now & "  " & str
       end if
    end sub

    any ideas?

    Friday, September 2, 2011 7:46 PM

All replies