?
Solved

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

Posted on 2007-10-15
2
Medium Priority
?
2,249 Views
Last Modified: 2011-10-03
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*******************************
0
Comment
Question by:GusGallows
2 Comments
 
LVL 12

Accepted Solution

by:
GusGallows earned 0 total points
ID: 20086210
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
 
LVL 1

Expert Comment

by:Vee_Mod
ID: 20094480
Closed, 500 points refunded.
Vee_Mod
Community Support Moderator
0

Featured Post

Problems using Powershell and Active Directory?

Managing Active Directory does not always have to be complicated.  If you are spending more time trying instead of doing, then it's time to look at something else. For nearly 20 years, AD admins around the world have used one tool for day-to-day AD management: Hyena. Discover why

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This month, Experts Exchange sat down with resident SQL expert, Jim Horn, for an in-depth look into the makings of a successful career in SQL.
There can be many situations demanding the conversion of Outlook OST files to PST format and as such, there is no shortage of automated tools to perform this conversion. However, what makes Stellar OST to PST converter stand above the rest? Let us e…
To add imagery to an HTML email signature, you have two options available to you. You can either add a logo/image by embedding it directly into the signature or hosting it externally and linking to it. The vast majority of email clients display l…
This video demonstrates how to sync Microsoft Exchange Public Folders with smartphones using CodeTwo Exchange Sync and Exchange ActiveSync. To learn more about CodeTwo Exchange Sync and download the free trial, go to: http://www.codetwo.com/excha…
Suggested Courses

862 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