How to associate external account to mailbox and assign rights using vbscript?

I have written a script which works quite well with creating a new user, mail-enabling it, hiding it from the address book, and disabling it. However, I cannot for the life of me figure out how to Associate an External Account to it in VBScript and grant it full control rights both in the user account and in the mailbox. Below is my code for reference. Does anyone know what code I can add to this that will do the two things I am trying to get it to do?
******************************Code Follows:******************************************
Option Explicit
On Error Resume Next
'***********************************************
'*       Assign Variables                      *
'***********************************************
Dim oFSO, inFSO, oFile, inFile, oText
Dim strSamName, strSirName, strGivenName, strContainer, strMail, strCN, strDisplayName, strHomeMDB
Dim strEmpNo, strAddress, strCity, strState, strZip, strDept, strDeptNo, strCompany
Dim strOfficePhone, strFax
Dim strInFileName, strOutFileName, strInput
Dim strSplit
Dim objRootDSE, objContainer, objUser

' set constants
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8

strInFileName = WScript.Arguments.Unnamed.Item(0)
strOutFileName = WScript.Arguments.Unnamed.Item(1)
'msgbox strInFileName
'msgbox strOutFileName

set inFSO = CreateObject("Scripting.FileSystemObject") 'start file systems object input file
Set inFile = inFSO.GetFile(strInFileName) ' open filename specified in argument
Set oText = inFile.OpenAsTextStream (ForReading) 'Open Text file for Input'
Set oFSO = CreateObject("Scripting.FileSystemObject")       ' start file system object for Output file
Set oFile = oFSO.OpenTextFile(strOutFileName, ForWriting)      ' File will overwrite previous files using oFile.WriteLine

strInput = ""
Do While strInput <> "END, END"
      strInput = oText.ReadLine
      if strInput = "END, END" then
            Exit Do
      End If
      strSplit = Split(strInput, chr(9))
            strNTName = trim(strSplit(0))
            strEmpNo = trim(strSplit(1))
            strSirName = trim(strSplit(3))
            strGivenName = trim(strSplit(4))
            strDisplayName = trim(strSirname) & ", " & trim(strGivenName)
            strAddress = trim(strSplit(5))
            strCity = trim(strSplit(6))
            strState = trim(strSplit(7))
            strZip = trim(strSplit(8))
            strDept = trim(strSplit(9))
            strDeptNo = trim(strSplit(10))
            strCompany = trim(strSplit(11))
            strOfficePhone = trim(strSplit(12))
            strFax = trim(strSplit(13))
            strCN = trim(strGivenName) & " " & trim(strSirName)
            strSamName = trim(Left(strGivenName,1)) & trim(strSirName)
            strHomeMDB = "CN=StoreName,CN=Storage Group Name,CN=InformationStore,CN=Server Name,CN=Servers,CN=SiteName,CN=Administrative Groups,CN=OrgName,CN=Microsoft Exchange,CN=Services,CN=Configuration,DC=domainname,DC=net"
            strMail = trim(strSamName) & "@email.com"
            strContainer = "OU=Staging,DC=domainname,DC=net"
            


      '***********************************************
      '*         Connect to a container              *
      '***********************************************
      Set objRootDSE = GetObject("LDAP://rootDSE")
      If strContainer = "" Then
        Set objContainer = GetObject("LDAP://" & _
          objRootDSE.Get("defaultNamingContext"))
      Else
        Set objContainer = GetObject("LDAP://" & strContainer)
      End If
      '***********************************************
      '*       End connect to a container            *
      '***********************************************
      '*       Create User and Mail-Enable           *
      '***********************************************

      Set objUser = objContainer.Create("user", "cn=" & strCN)

      wscript.echo "cn=" & strCN
      oFile.WriteLine "cn=" & strCN
      objUser.Put "cn", strCN

      wscript.echo "employeeNumber=" & strEmpNo
      oFile.WriteLine "employeeNumber=" & strEmpNo
      objUser.Put "employeeNumber", strEmpNo

      wscript.echo "sAMAccountName=" & strSamName
      oFile.WriteLine "sAMAccountName=" & strSamName
      objUser.Put "sAMAccountName", strSamName

      wscript.echo "sn=" & strSirName
      oFile.WriteLine "sn=" & strSirName
      objUser.Put "sn",strSirName

      wscript.echo "givenName=" & strGivenName
      oFile.WriteLine "givenName=" & strGivenName
      objUser.Put "givenName", strGivenName

      If strAddress <> "" then
            wscript.echo "streetAddress=" & strAddress
            oFile.WriteLine "streetAddress=" & strAddress
            objUser.Put "streetAddress", strAddress
      End If

      If strCity <> "" then
            wscript.echo "l=" & strCity
            oFile.WriteLine "l=" & strCity
            objUser.Put "l", strCity
      End If
      
      If strState <> "" then
            wscript.echo "st=" & strState
            oFile.WriteLine "st=" & strState
            objUser.Put "st", strState
      End If

      If strZip <> "" then
            wscript.echo "postalCode=" & strZip
            oFile.WriteLine "postalCode=" & strZip
            objUser.Put "postalCode", strZip
      End If

      If strDept <> "" then
            wscript.echo "department=" & strDept
            oFile.WriteLine "department=" & strDept
            objUser.Put "department", strDept
      End If

      If strDeptNo <> "" then
            wscript.echo "departmentNumber=" & strDeptNo
            oFile.WriteLine "departmentNumber=" & strDeptNo
            objUser.Put "departmentNumber", strDeptNo
      End If

      If strCompany <> "" then
            wscript.echo "company=" & strCompany
            oFile.WriteLine "company=" & strCompany
            objUser.Put "company", strCompany
      End If

      If strOfficePhone <> "" then
            wscript.echo "telephoneNumber=" & strOfficePhone
            oFile.WriteLine "telephoneNumber=" & strOfficePhone
            objUser.Put "telephoneNumber", strOfficePhone
      End If

      If strFax <> "" then
            wscript.echo "facsimileTelephoneNumber=" & strFax
            oFile.WriteLine "facsimileTelephoneNumber=" & strFax
            objUser.Put "facsimileTelephoneNumber", strFax
      End If

      wscript.echo "distinguishedName=CN=" & strCN & "," & strContainer
      oFile.WriteLine "distinguishedName=CN=" & strCN & "," & strContainer
      objUser.Put "distinguishedName", "CN=" & strCN & "," & strContainer

      wscript.echo "displayName=" & strDisplayName
      oFile.WriteLine "displayName=" & strDisplayName
      objUser.Put "displayName", strDisplayName

      wscript.echo "mail=" & strMail
      oFile.WriteLine "mail=" & strMail
      objUser.MailEnable strMail

      wscript.echo "homeMDB=" & strHomeMDB
      oFile.WriteLine "homeMDB=" & strHomeMDB
      objUser.Put "homeMDB", strHomeMDB

      objUser.Put "internetEncoding",1310720

      objUser.Put "msExchHideFromAddressLists", "TRUE"

      objUser.SetInfo
      If (Err.Number<> 0) Then
            
            On Error Resume Next
            wScript.Echo = "Error number = " & Err.Number
            wScript.Echo "User creation or Mail-Enable failed"
            oFile.WriteLine "User creation or Mail-Enable failed with error number " & Err.Number
            wscript.echo strSamName & "," & strSirName & "," & strGivenName & "," & strContainer & "," & strMail
            oFile.WriteLine strSamName & "," & strSirName & "," & strGivenName & "," & strContainer & "," & strMail
            
      Else
            objUser.SetPassword "P@$$w0rd"
            wscript.echo "Successfully created " & strCN & "."
            oFile.WriteLine "Successfully created " & strCN & "."
            wscript.echo "Successfully mail enabled " & strCN & " and hidden from the GAL."
            oFile.WriteLine "Successfully mail enabled " & strCN & " and hidden from the GAL."
      End If
      oFile.WriteLine "--------------------------------------------------------------------------------------------------"
Loop

oFile.Close
inFile.Close
set oFSO = Nothing
set oFIle = Nothing
set inFSO = Nothing
set inFile = Nothing
set oText = Nothing
strInput = ""
*********************************End of Code*******************************
LVL 12
GusGallowsAsked:
Who is Participating?
 
GusGallowsAuthor Commented:
Never mind. I figured out. See attached code:
*****************Code Begins*********************

On Error Resume Next

strLogFile = "Created_Users_and_Mailboxes.txt"
strUserFileName = "list.txt"
bContinue = True

Set fs = CreateObject("Scripting.FileSystemObject")
Set fileout= fs.OpenTextFile(strlogfile,8,True)
Set tsNewUsers = fs.OpenTextFile(strUserFileName, 1, -1)

fileout.writeline:fileout.writeline("*************************************************************************************")
fileout.writeline("Beginning creation of new users and mailboxes on " & Now)
fileout.writeline
arrNewUsersInfo = Split(tsNewUsers.ReadAll, vbCrLF)'Chr(13))
' Iterate through the array of new users.
For iLineNum = 0 To UBound(arrNewUsersInfo)
       wscript.sleep(1000)
       Err.Clear
       bContinue = True

       ' Split the given name, surname, alias, and
       ' password strings into the array.
    arrCurrUserInfo = Split(arrNewUsersInfo(iLineNum), Chr(9), -1, 1)

       ' Check the number of elements in the array.
       If UBound(arrCurrUserInfo) = 18 Then

               ' Get the given name, surname, e-mail alias, and password from the array.
             strGivenName = arrCurrUserInfo(4)
             strSurname = arrCurrUserInfo(3)
             strAlias = trim(Left(strGivenName,1)) & trim(strSurName)
             strNTName = arrCurrUserInfo(0)
             strExchServerName = arrCurrUserInfo(15)
             strStorageGroup = arrCurrUserInfo(16)
             strMailboxStore = arrCurrUserInfo(17)
             strTrustedDomain = arrCurrUserInfo(14)
                                 
             strExternalAccount = strTrustedDomain & "\" & strNTName


      If bContinue Then
          
                bContinue = Add_ACE_ADUser(strGivenName & " " & strSurName)    
          
      End If
   
          If bContinue Then
   
                bContinue = Add_ACE_Mailbox(strGivenName & " " & strSurName)    
   
          End If
   

      fileout.writeline("")
End If
Next


fileout.writeline
fileout.writeline("Creation of users and mailboxes ended on " & Now & ": " & iLineNum & " users processed.")
fileout.writeline("*************************************************************************************")

tsNewUsers.Close
Set fs = Nothing
Set tsNewUsers = Nothing

'//////////////////////////////////////////////////////////////////////////////////
'// Function:      Add Read & Send As permissions to the new User object
'//
'// Purpose:      This code will add a (trusted) external user account to the ACE
'//                        list with Read & Send As permission
'//
'// Input:            strUser            = the User object that needs to have its ACL changed
'//
'// Returns:      True if the ACE addition was succesful.
'/////////////////////////////////////////////////////////////////////////////////

Function Add_ACE_ADUser(strADUser)
      
      On Error Resume Next
      
      Dim oUser
      Dim oSecurityDescriptor
      Dim dacl
      Dim ace
      Dim strOU
      Dim strDomainDN
      
      strDomainDN = "DC=DOMAIN,DC=net"
      strOU = "OU=Staging"
      
      Add_ACE_ADUser = False
            fileout.writeline Err.Number
      Set oUser = GetObject ("LDAP://cn=" & strADUser & "," & strOU & "," & strDomainDN)
            fileout.writeline Err.Number & " Set oUser"
      Set oSecurityDescriptor = oUser.Get("ntSecurityDescriptor")
            fileout.writeline Err.Number & " Set oSecurityDescriptor"
      Err.Clear
      fileout.writeline Err.Number
      ' Extract the Discretionary Access Control List (DACL) using the IADsSecurityDescriptor.
      ' Interface.
      Set dacl = oSecurityDescriptor.DiscretionaryAcl
            fileout.writeline Err.Number & " Set dacl = oSecurityDescriptor.DiscretionaryAcl"
      Set ace = CreateObject("AccessControlEntry")
            fileout.writeline Err.Number & " Set ace = CreateObject(" & Chr(34) & "AccessControlEntry" & Chr(34) & ")"
      
      ' Template: AddAce(TrusteeName, gAccessMask, gAceType, gAceFlags, gFlags, gObjectType, gInheritedObjectType)
       AddAce dacl,strExternalAccount,&H20014,0,0,1,0,0      '&H20014 -> gives Read permissions
            fileout.writeline Err.Number & " AddAce dacl,strExternalAccount,&H20014,0,0,1,0,0"
       AddAce dacl,strExternalAccount,&H100,5,0,1,"{AB721A54-1E2F-11D0-9819-00AA0040529B}",0      '&H100 & the string -> enables the Send As permissions
            fileout.writeline Err.Number & " AddAce dacl,strExternalAccount,&H100,5,0,1," & Chr(34) & "{AB721A54-1E2F-11D0-9819-00AA0040529B}" & Chr(34) & ",0"
       ' Add the modified DACL to the security descriptor.
       oSecurityDescriptor.DiscretionaryAcl = dacl
            fileout.writeline Err.Number & " oSecurityDescriptor.DiscretionaryAcl = dacl"      
       ' Save new SD onto the user.
       oUser.Put "ntSecurityDescriptor",Array(oSecurityDescriptor)
            fileout.writeline Err.Number & " oUser.Put " & Chr(34) & "ntSecurityDescriptor" & Chr(34) & ",Array(oSecurityDescriptor)"
       ' Commit changes from the property cache to the information store.
       oUser.SetInfo
            fileout.writeline Err.Number & " oUser.SetInfo"
       If Err.Number <> 0 Then
             fileout.writeline "... Failed to give the 'Read' & 'Send As' permissions to the account: " & strExternalAccount & " " & Err.Description & "(" & Err.Number & ")."
             If Err.Number = -2147023559 Then fileout.writeline "... The External account " & strExternalAccount & " probably doesn't exist."
             Add_ACE_ADUser = False
             Exit Function
       End If
      
       Add_ACE_ADUser = True
      
       fileout.writeline "... Succesfully added the 'Read' & 'Send As' permissions to the account " & strExternalAccount & "."
      
       'Clean up
       Set oUser = nothing
       Set oSecurityDescriptor = nothing
      
 End Function
 
 
 
'//////////////////////////////////////////////////////////////////////////////////
'// Function:      Adds Read, Full mailbox access & Associate Extenal Account
'//                        permissions to the new User object
'//
'// Purpose:      This code will add a (trusted) external user account to the ACE
'//                        list with Read, Full mailbox access & Associate Extenal Account
'//                        permission
'//
'// Input:            strUser            = the User object that needs to have its ACL changed
'//
'// Returns:      True if the ACE addition was succesful.
'/////////////////////////////////////////////////////////////////////////////////

Function Add_ACE_Mailbox(strADUser)

      On Error Resume Next
      
      Dim oUser
      Dim oSecurityDescriptor
      Dim dacl
      Dim ace
      Dim btemp
      Dim strOU
      Dim strDomainDN
      
      strDomainDN = "DC=DOMAIN,DC=NET"
      strOU = "OU=Staging"
      
      Add_ACE_Mailbox = False
      
      Set oUser = GetObject ("LDAP://cn=" & strADUser & "," & strOU & "," & strDomainDN)
      
      ' Get the Mailbox security descriptor (SD).
      Set oSecurityDescriptor = oUser.MailboxRights
      
      ' Extract the Discretionary Access Control List (DACL) using the IADsSecurityDescriptor.
      ' Interface.
      Set dacl = oSecurityDescriptor.DiscretionaryAcl
      Set ace = CreateObject("AccessControlEntry")
      
      'Since you can't add the  Associated External Account if another user already got it
      bTemp=1
      For Each ace In dacl
      ' Display all the properties of the ACEs using the IADsAccessControlEntry interface.
      'WScript.Echo ace.Trustee & ", " & ace.AccessMask & ", " & ace.AceType & ", " & ace.AceFlags & ", " & ace.Flags & ", " & ace.ObjectType & ", " & ace.InheritedObjectType
          If (ace.AccessMask And 131079) = 131079 Then
            bTemp=0
            Exit For
          End If
      Next
      
      ' Template: AddAce(TrusteeName, gAccessMask, gAceType, gAceFlags, gFlags, gObjectType, gInheritedObjectType)
      if bTemp=1 Then
       AddAce dacl,strExternalAccount,983047,0,2,0,0,0
       ' Add the modified DACL to the security descriptor.
       oSecurityDescriptor.DiscretionaryAcl = dacl
       ' Save new SD onto the user.
       oUser.MailboxRights = oSecurityDescriptor
       ' Commit changes from the property cache to the information store.
       oUser.SetInfo
       'objlogfile.writeline obname & "," & strFound & "," & Now & ",Modified"
      Else
                  fileout.writeline "... Failed to give the 'Read', 'Full Mailbox Access' & 'Associate External Account' permissions to the account:"
                  fileout.writeline "...             These permlissions are already defined on another account."
      End If
      
      If Err.Number <> 0 Then
             fileout.writeline "... Failed to give the 'Read', 'Full Mailbox Access' & 'Associate External Account' permissions to the account: " & Err.Description & "(" & Err.number & ")."
             If Err.Number = -2147023559 Then fileout.writeline "... The External account " & strExternalAccount & " probably doesn't exist."
             Add_ACE_ADUser = False
             Exit Function
       End If
      
       Add_ACE_ADUser = True
      
       if bTemp=1 Then fileout.writeline "... Succesfully added the 'Read', 'Full Mailbox' & 'Associate External Account' permissions to the account."
      
       'Clean up
       Set oUser = nothing
       Set oSecurityDescriptor = Nothing
      
End Function




'//////////////////////////////////////////////////////////////////////////////////
'// Function:      Changes the ACL of an object
'//
'// Purpose:      This code actually changes the ACL list of the object.
'//
'// Input:     dacl  = The domain controller on which the user
'//                    object will be created.
'//
'//            TrusteeName                  = The (external) account to give permissions to.
'//
'//            gAccessMask                  = The access mask value
'//
'//            gAceType                        = The acetype flag value
'//
'//            gAceFlags                  = The aceflags flag value
'//
'//            gFlags                        = The flags flag value
'//
'//            gObjectType                  = The objecttype value
'//
'//            gInheritedObjectType      = The inherited value
'//
'// Returns:      The ACL Object.
'/////////////////////////////////////////////////////////////////////////////////

Function AddAce(dacl, TrusteeName, gAccessMask, gAceType, gAceFlags, gFlags, gObjectType, gInheritedObjectType)

      Dim Ace1
      
      ' Create a new ACE object.
      Set Ace1 = CreateObject("AccessControlEntry")
      Ace1.AccessMask = gAccessMask
      Ace1.AceType = gAceType
      Ace1.AceFlags = gAceFlags
      Ace1.Flags = gFlags
      Ace1.Trustee = TrusteeName
      
      'See whether ObjectType must be set
      If CStr(gObjectType) <> "0" Then
            Ace1.ObjectType = gObjectType
      End If
      
      'See whether InheritedObjectType must be set.
      If CStr(gInheritedObjectType) <> "0" Then
            Ace1.InheritedObjectType = gInheritedObjectType
      End If
      
      dacl.AddAce Ace1
      
      ' Clean up
      Set Ace1 = Nothing

End Function

*****************Code Ends***********************
0
 
Vee_ModCommented:
Closed, 500 points refunded.
Vee_Mod
Community Support Moderator
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.