Customize exch-add-user.vbs script.

Below is a VBS script that creates AD accounts with some very specific options. I need help editing the script to add the user to a spc=ecific group as opposed to the allusers group.

The group i want to add to is: CN=McRae Employees,OU=McRaeAgency.com,OU=Hosting,DC=BCCHOST,DC=LOCAL

Thanks for any help.
Script starts now.
'
' exch-add-user.vbs
'
' Add an Exchange hosted user account.
'
' Required parameters:
'
'    Name   Example value
' 1) domain   zippy.com
' 2) domain_prefix  zip
' 3) AccountName  info
' 4) firstname (givenName) John
' 5) lastname (sn)  Doe
' 6) password   z1ppy
' 7) OAB   "Offline Address List - Zippy"
'
' This script does everything required to add a new user to a hosted
' Exchange domain.
'
' This script is a "production quality" script. It does error checking,
' parameter validity checking, and backs out any changes (i.e., removes
' a temporary user object if it's already been created) in case an
' error occurs. However, error messages are system-level messages and
' aren't translated for the non-technical user (well, two are, but only
' two -- object not found and object already exists).
'
' This script has only been tested on Windows XP workstations which are
' talking to Exchange Server 2003. Minor changes would be required to
' support the Exchange 2000 Server Management Tools and to support Windows
' 2000 Professional workstations.
'
' To modify for your environment, change the OU_HOSTING, ExchServer, and
' Trustee constants as required. If you are using non-default names for
' your mailbox stores, that will require changing as well. If you do not
' want an additional Trustee added to the mailbox, set Trustee to "" (the
' empty string).
'
Option Explicit
Const OU_HOSTING = "OU=Hosting"  ' the OU where I put customer OU's
Const ExchServer = "HOSTED"  ' the exchange server whose default mailbox store I'll use
Const Trustee    = "Domain Admins" ' an extra ACL to add to the mailbox
Const bDebug     = False  ' verbose output
Dim strNamingContext, strConfigContext
Dim strOrgDN
Dim strNetBIOSDomain, strNetBIOSComputer
Dim strTrustee
Dim strMailboxStoreDN, strOABContainer
Dim strServerList, strServerListDN
Dim strOALList, strUserOAL
Dim Com, Conn, Rs  ' for ADO
' Constants we need for ADSI calls
Const ADS_UF_DONT_EXPIRE_PASSWD = &H10000
Const ADS_PROPERTY_APPEND = 3
Const ADS_PROPERTY_DELETE = 4
Const ADS_ACETYPE_ACCESS_ALLOWED = 0
Const ADS_ACEFLAG_INHERIT_ACE    = &H2
' Constants we need for WBEM calls
Const wbemFlagReturnImmediately = &H10
Const wbemFlagForwardOnly = &H20
 ' Main program
 If WScript.Arguments.Count <> 6 Then
  e "Usage: exch-new-user.vbs domain domain_prefix accountname firstname lastname password OAB"
  WScript.Quit 1
 End If
 strUserOAL = WScript.Arguments (5)
 Call DoSetup
 CreateHostedUser WScript.Arguments (0), WScript.Arguments (1), _
    WScript.Arguments (2), WScript.Arguments (3), _
    WScript.Arguments (4), WScript.Arguments (5)
 e "Done."
 Call ClearSystemInfo
 WScript.Quit 0
Sub DoSetup
 Call GetSystemInfo
 Call GetAllServers
 Call GetAllOfflineAddressLists
 If Not FindServer (ExchServer) Then
  e "*** Error: " & ExchServer & " is not an Exchange server in this A/D forest."
  e "*** Error: This program will fail. Terminating."
  Call ClearSystemInfo
  WScript.Quit 1
 End If
 If Not FindServer (strNetBIOSComputer) Then
  If Not IsExchangeManagementInstalled Then
   e "*** ERROR: Exchange Management is not installed on this computer."
   e "*** ERROR: This program will fail. Terminating."
   Call ClearSystemInfo
   WScript.Quit 1
  End If
  e "*** WARNING: This computer is not an Exchange server."
  e "*** WARNING: This program has not been tested in this configuration. Continuing."
 End If
 If Not FindOAL (strUserOAL) Then
  e "*** ERROR: Specified OAL '" & strUserOAL & "' does not exist."
  e "*** ERROR: This program will fail. Terminating."
  Call ClearSystemInfo
  WScript.Quit 1
 End If
 ' build the fully qualified trustee based on this domain
 If Len (Trustee) > 0 Then
  strTrustee = strNetBIOSDomain & "\" & Trustee
 Else
  strTrustee = ""
 End If
 ' getting the strMailboxStoreDN from A/D is pretty easy,
 ' but with multiple servers, you need to pick one. this
 ' is the one I pick.
 strMailboxStoreDN =     "CN=Mailbox Store (" & ExchServer & ")," & _
    "CN=First Storage Group," & _
    "CN=InformationStore," & _
    "CN=" & ExchServer & "," & _
    "CN=Servers," & _
    "CN=First Administrative Group," & _
    "CN=Administrative Groups," & _
    strOrgDN
 ' this is the DN of the Offline Address Books container. the
 ' value of msExchUseOAB is a specific OAB in this container.
 strOABContainer = "CN=Offline Address Lists,"   & _
     "CN=Address Lists Container," & _
     strOrgDN
End Sub
Sub GetSystemInfo
 Dim objSystemInfo, objWSHNetwork, objRootDSE
 Set objRootDSE = GetObject ("LDAP://RootDSE")
 strNamingContext = objRootDSE.Get ("defaultNamingContext")
 strConfigContext = objRootDSE.Get ("configurationNamingContext")
 Set objRootDSE = Nothing
 ' get the NetBIOS domain name
 Set objSystemInfo = CreateObject ("ADSystemInfo")
 strNetBIOSDomain = objSystemInfo.DomainShortName
 Set objSystemInfo = Nothing
 ' get the NetBIOS computer name
 Set objWSHNetwork = CreateObject ("WScript.Network")
 strNetBIOSComputer = objWSHNetwork.ComputerName
 Set objWSHNetwork = Nothing
 If bDebug Then
  e "strNamingContext: " & strNamingContext
  e "strConfigContext: " & strConfigContext
  e "strNetBIOSDomain: " & strNetBIOSDomain
  e "strNetBIOSComputer: " & strNetBIOSComputer
 End If
 Call InitializeADSI
 If GetOrganizationInformation Then
  Call ClearSystemInfo
  WScript.Quit 1
 End If
End Sub
Sub ClearSystemInfo
 Call DoneWithADSI
End Sub
Sub CreateHostedUser   (ByVal strDomain, _
   ByVal strAccountName, _
   ByVal strFirstName, _
   ByVal strLastName, _
   ByVal strPassword, _
   ByVal strOAB)
 Dim strName  ' this will be <firstname> <lastname>, used for CN and displayName
 Dim strsAMAccountName ' this will be strAccountName
 Dim strOU  ' OU in which to create the user
 Dim objParent  ' GetObject() of strOU
 Dim objUser  ' new user object
 Dim objExchUser  ' CDOEXM object from new user object
 Dim iUAC  ' value of userAccountControl attribute
 On Error Resume Next
 strName = strFirstName & " " & strLastName
 strsAMAccountName = strAccountName
 strOU = "OU=" & strDomain & "," & OU_HOSTING & "," & strNamingContext
 ' for examples:
 ' see KB 304935
 ' see http://www.rallenhome.com/books/adcookbook/src/06.01-create_user--correction.vbs.txt
 '
 ' EXAMPLE INPUT:
 ' strDomain = zippy.com
 ' strAccountName = info
 ' strFirstName = John
 ' strLastName = Doe
 ' strPassword = z1ppy
 ' EXAMPLE CALCULATED:
 ' strName = John Doe
 ' strsAMAccountName = zip_info
 ' UPN = info@zippy.com
 ' strOU = LDAP://OU=zippy.com,OU=Hosting,DC=brnets,DC=local
 If bDebug Then
  e "Input strDomain: " & strDomain
  e "Input strAccountName: " & strAccountName
  e "Input strFirstName: " & strFirstName
  e "Input strLastName: " & strLastName
  e "Input strPassword: " & strPassword
  e "Input strOAB: " & strOAB
  e "Calc strName: " & strName
  e "Calc strsAMAccountName: " & strsAMAccountName
  e "Calc UPN: " & strAccountName & "@" & strDomain
  e "Calc strOU: " & strOU
  e "Calc strTrustee: " & strTrustee
  e "Calc strMailboxStoreDN: " & strMailboxStoreDN
  e "Calc strOABContainer: " & strOABContainer
  e "Const OU_HOSTING: " & OU_HOSTING
 End If
 Set objParent = GetObject ("LDAP://" & strOU)
 If ErrorReport ("on GetObject (" & strOU & ")") Then
  Exit Sub
 End If
 Set objUser = objParent.Create ("user", "CN=" & strName)
 If ErrorReport ("on Create (CN=" & strName & ")") Then
  Exit Sub
 End If
 objUser.Put "sAMAccountName", strsAMAccountName
 objUser.Put "userPrincipalName", strAccountName & "@" & strDomain
 objUser.Put "givenName", strFirstName
 objUser.Put "sn", strLastName
 objUser.Put "displayName", strName
 objUser.Put "name", strName
 objUser.SetInfo
 If ErrorReport ("on first SetInfo") Then
  Set objUser = Nothing
  Exit Sub
 End If
 objUser.SetPassword (strPassword)
 objUser.AccountDisabled = FALSE
 objUser.SetInfo
 If ErrorReport ("on second SetInfo (Enable Account)") Then
  Call objParent.Delete ("user", "CN=" & strName)
  Set objUser = Nothing
  Exit Sub
 End If
 ' set "Password never expires"
 iUAC = objUser.Get ("userAccountControl")
 If (iUAC And ADS_UF_DONT_EXPIRE_PASSWD) Then
  ' already set
 Else
  iUAC = iUAC XOR ADS_UF_DONT_EXPIRE_PASSWD
 End If
 objUser.Put "userAccountControl", iUAC
 dp "userAccountControl " & iUAC
 ' set the mailnickname
 objUser.mailNickname = strsAMAccountName
 ' set the OU for OWA to use
 objUser.msExchQueryBaseDN = strOU
 ' set the mail attribute to the UPN (will be overwritten by RUS - see KB 318072)
 objUser.Mail = strAccountName & "@" & strDomain
 ' flush the property cache
 objUser.SetInfo
 If ErrorReport ("on third SetInfo (userAccountControl, mailNickname, msExchQUeryBaseDN, Mail)") Then
  Call objParent.Delete ("user", "CN=" & strName)
  Set objUser = Nothing
  Exit Sub
 End If
 ' set the OAB for the user (both OWA and Outlook)
 objUser.msExchUseOAB = "CN=" & strOAB & "," & strOABContainer
 
 ' flush the property cache
 objUser.SetInfo
 If ErrorReport ("on fourth SetInfo (msExchUseOAB)") Then
  Call objParent.Delete ("user", "CN=" & strName)
  Set objUser = Nothing
  Exit Sub
 End If
 ' add the user to the normal groups for this OU
 AddUserToGroup strName, "mcraeemployees"
 'AddUserToGroup strName, "NormalUsers@" & strDomain, strDomain
 ' Create the user's mailbox
 ' Leave this to absolute last, because this is the most
 ' likely failure point - if this script isn't being run
 ' on an Exchange server, the Exchange Management Tools must
 ' be installed.
 Set objExchUser = objUser
 objExchUser.CreateMailBox strMailboxStoreDN
 If ErrorReport ("on CreateMailBox (" & strMailboxStoreDN & ")") Then
  'Call objParent.Delete ("user", "CN=" & strName)
  Set objUser = Nothing
  Exit Sub
 End If
 
 objUser.SetInfo
 If ErrorReport ("on fifth SetInfo (after CreateMailbox)") Then
  Call objParent.Delete ("user", "CN=" & strName)
  Set objUser = Nothing
  Exit Sub
 End If
 ' update the security on the mailbox
 AddNewTrustee objUser
 Set objUser = Nothing
End Sub
Sub AddUserToGroup (strName)
 ' see http://www.rallenhome.com/books/adcookbook/src/07.04-add_group_member.vbs.txt
 Dim strGroupDN, strUserDN
 Dim objGroup
 On Error Resume Next
 If bDebug Then
  e "AddUserToGroup strName: " & strName
 
 End If
 
 strGroupDN = "LDAP://CN=" & strGroup & ","
 strGroupDN = strGroupDN & "OU=" & strDomain & "," & OU_HOSTING & "," & strNamingContext
 dp "Calc strGroupDN: " & strGroupDN
 Set objGroup = GetObject (strGroupDN)
 If ErrorReport ("on GetObject (" & strGroupDN & ")") Then
  Exit Sub
 End If
 strUserDN = "LDAP://CN=" & strName & ","
 strUserDN = strUserDN & "OU=" & strDomain & "," & OU_HOSTING & "," & strNamingContext
 dp "Calc strUserDN: " & strUserDN
 objGroup.Add (strUserDN)
 If ErrorReport ("on objGroup.Add (" & strUserDN & ")") Then
  Set objGroup = Nothing
  Exit Sub
 End If
 Set objGroup = Nothing
End SUb
Sub AddNewTrustee (objUser)
 ' see KB 304935
 ' this code requires Windows XP/Windows Server 2003 or
 ' Adssecurity.dll to be installed on Windows 2000
 Dim objSecurityDescriptor ' SD from msExchMailboxSecurityDescriptor of new user
 Dim objDACL    ' DiscretionaryACL from SD of msExchMailboxSecurityDescriptor of new user
 On Error Resume Next
 If Len (strTrustee) = 0 Then
  Exit Sub
 End If
 ' Get the copy Mailbox Security Descriptor (SD) stored on the
 ' msExchMailboxSecurityDescriptor attribute
 objUser.GetInfoEx Array ("msExchMailboxSecurityDescriptor"), 0
 Set objSecurityDescriptor = objUser.Get ("msExchMailboxSecurityDescriptor")
 If ErrorReport ("on Get (msExchMailboxSecurityDescriptor)") Then
  Exit Sub
 End If
 ' Extract the Discretionary Access Control List (ACL) using the
 ' IADsSecurityDescriptor interface
 Set objDACL = objSecurityDescriptor.DiscretionaryAcl
 ' Setting the Access Mask to 131075 enables "full mailbox access" and
 ' "read" priviledges
 AddAce objDACL, strTrustee, 131075, _
  ADS_ACETYPE_ACCESS_ALLOWED, ADS_ACEFLAG_INHERIT_ACE, 0, 0, 0
 ' Add the modified DACL back onto the Security Descriptor
 objSecurityDescriptor.DiscretionaryAcl = objDACL
 ' Save New SD onto the user
 objUser.Put "msExchMailboxSecurityDescriptor", objSecurityDescriptor
 ' Commit changes from the property cache to the information store
 objUser.SetInfo
 If ErrorReport ("SetInfo (msExchMailboxSecurityDescriptor)") Then
  Exit Sub
 End If
End Sub
'********************************************************************
'*
'* Function AddAce (dacl, TrusteeName, gAccessMask, gAceType,
'*            gAceFlags, gFlags, gObjectType, gInheritedObjectType)
'*
'* Purpose: Adds an ACE to a DACL
'* Input:       dacl            Object's Discretionary Access Control List
'*              TrusteeName     SID or Name of the trustee user account
'*              gAccessMask     Access Permissions
'*              gAceType        ACE Types
'*              gAceFlags       Inherit ACEs from the owner of the ACL
'*              gFlags          ACE has an object type or inherited object type
'*              gObjectType     Used for Extended Rights
'*              gInheritedObjectType
'*
'* Output:  Object - New DACL with the ACE added (update dacl param)
'*
'********************************************************************
Function AddAce (dacl, TrusteeName, gAccessMask, _
                 gAceType, gAceFlags, gFlags,    _
                 gObjectType, gInheritedObjectType)
 Dim objACE
 On Error Resume Next
 ' Create a new ACE object
 Set objACE = CreateObject ("AccessControlEntry")
 If ErrorReport ("CreateObject (AccessControlEntry)") Then
  Exit Function
 End If
 objACE.AccessMask = gAccessMask
 objACE.AceType = gAceType
 objACE.AceFlags = gAceFlags
 objACE.Flags = gFlags
 objACE.Trustee = TrusteeName
 'Check to see if ObjectType needs to be set
 If CStr (gObjectType) <> "0" Then
  objACE.ObjectType = gObjectType
 End If
 'Check to see if InheritedObjectType needs to be set
 If CStr (gInheritedObjectType) <> "0" Then
  objACE.InheritedObjectType = gInheritedObjectType
 End If
 dacl.AddAce objACE
 ' clean up ACE object
 Set objACE = Nothing
End Function
Sub e (str)
 WScript.Echo str
End Sub
Sub dp (str)
 If bDebug Then e str
End Sub
Function ErrorReport (str)
 If Err.Number Then
  ErrorReport = True
  e "Error 0x" & CStr (Hex (Err.Number)) & " occurred " & str
  If Err.Description <> "" Then
                 e "Error description: " & Err.Description
  Else
   Select Case Err.Number
    Case &H80071392
     e "Error Description: Object already exists"
    Case &H80072030
     e "Error Description: No such object"
    Case Else
     If (Err.Number And &HFFFF0000) = &H80070000 Then
      e "Error Description found by: net helpmsg " & _
       (Err.Number And 65535)
     End If
   End Select
  End If
  Err.Clear
 Else
  ErrorReport = False
 End If
End Function
Sub InitializeADSI
 Set Com  = WScript.CreateObject ("ADODB.Command")
 Set Conn = WScript.CreateObject ("ADODB.Connection")
 ' Open the connection.
 Conn.Provider = "ADsDSOObject"
 Conn.Open "ADs Provider"
End Sub
Sub DoneWithADSI
 Conn.Close
 Set Com  = Nothing
 Set Conn = Nothing
End Sub
Sub DoLDAPQuery (strLDAPQuery, resultSet)
 Com.ActiveConnection = Conn
 Com.CommandText      = strLDAPQuery
 Set resultSet = Com.Execute
End Sub
Sub FinishLDAPQuery (resultSet)
 resultSet.Close
 Set resultSet = Nothing
End Sub
Function GetOrganizationInformation
 Dim strQuery
 GetOrganizationInformation = False
 ' Build a query to find the Exchange organization.
 strQuery = "<LDAP://" & strConfigContext & ">;" & _
  "(objectCategory=msExchOrganizationContainer);" & _
  "name,distinguishedName;" & _
  "subtree"
 strOrgDN = ""
 Call DoLDAPQuery (strQuery, Rs)
 ' If there are any results, there will only be one result. There
 ' may only be one Exchange organization per Active Directory forest.
 e "Exchange Organization Name: " & Rs.Fields ("name")
 If bDebug Then e "Organization DN: " & Rs.Fields ("distinguishedName")
 strOrgDN = Rs.Fields ("distinguishedName")
 Call FinishLDAPQuery (rs)
 If Len (strOrgDN) = 0 Then
  e "Cannot find Exchange organization information"
  GetOrganizationInformation = True
 End If
End Function
Sub GetAllServers
 Dim strQuery
 ' Now, get the list of all servers within the organization
 strQuery = "<LDAP://" & strOrgDN & ">;(objectCategory=msExchExchangeServer);name,cn,distinguishedName;subtree"
 strServerList   = ""
 strServerListDN = ""
 Call DoLDAPQuery (strQuery, Rs)
 e "All Exchange Servers in forest " & strNamingContext
 While Not Rs.EOF
  ' output the current server found
  dp "Server CN: " & Rs.Fields ("cn")
  e "Server Name: " & Rs.Fields ("name")
  dp "Server DN: " & Rs.Fields ("distinguishedName")
  If strServerList = "" Then
   strServerList   = Rs.Fields ("name")
   strServerListDN = Rs.Fields ("distinguishedName")
  Else
   strServerList   = strServerList   & ";" & Rs.Fields ("name")
   strServerListDN = strServerListDN & ";" & Rs.Fields ("distinguishedName")
  End If
  Rs.MoveNext
 Wend
 Call FinishLDAPQuery (Rs)
 ' Report our results
 dp "strServerList = " & strServerList
 dp "strServerListDN = " & strServerListDN
End Sub
Function FindServer (str)
 Dim arrServers
 Dim i
 arrServers = Split (strServerList, ";")
 For i = LBound (arrServers) to UBound (arrServers)
  If LCase (str) = LCase (arrServers (i)) Then
   FindServer = True
   Exit Function
  End If
 Next
 FindServer = False
End Function
Sub GetAllOfflineAddressLists
 Dim strQuery
 Dim str
 ' DN to Offline Address Lists container
 str = "CN=Offline Address Lists,CN=Address Lists Container," & strOrgDN
 ' Now, get the list of all offline address lists within the organization
 strQuery = "<LDAP://" & str& ">;(objectCategory=msExchOAB);name;subtree"
 strOALList = ""
 Call DoLDAPQuery (strQuery, Rs)
 e "All OALs in DN " & str
 While Not Rs.EOF
 ' e "OAL Name: " & Rs.Fields ("name")
  If strOALList = "" Then
   strOALList   = Rs.Fields ("name")
  Else
   strOALList   = strOALList   & ";" & Rs.Fields ("name")
  End If
  Rs.MoveNext
 Wend
 Call FinishLDAPQuery (Rs)
 ' Report our results
 dp "strOALList = " & strOALList
End Sub
Function FindOAL (str)
 Dim arrOAL
 Dim i
 arrOAL = Split (strOALList, ";")
 For i = LBound (arrOAL) to UBound (arrOAL)
  If LCase (str) = LCase (arrOAL (i)) Then
   FindOAL = True
   Exit Function
  End If
 Next
 FindOAL = False
End Function
' Thanks to Andy Webb for this idea
Function IsExchangeManagementInstalled
 Dim objWMIService
 Dim colItems, objItem
 Dim strComputer
 strComputer = "."
 Set objWMIService = GetObject ("winmgmts:\\" & strComputer & "\root\CIMV2")
 Set colItems = objWMIService.ExecQuery ("SELECT * FROM Win32_Service where Caption='Microsoft Exchange Management'", "WQL", _
  wbemFlagReturnImmediately + wbemFlagForwardOnly)
 ' if we get any items returned, it's installed
 For Each objItem In colItems
  IsExchangeManagementInstalled = True
  dp "Exchange Management is installed"
  Set colItems = Nothing
  Set objWMIService = Nothing
  Exit Function
 Next
 Set colItems = Nothing
 Set objWMIService = Nothing
 dp "Exchange Management is NOT installed"
 IsExchangeManagementInstalled = False
End Function