'********************************************************************
'* File: CrUM55.vbs *
'* Created: March 2003 *
'* Version: 1.0 *
'* *
'* Description: Utility for simultaneously creating Exchange 5.5 *
'* mailboxes and either an NT or AD user account. *
'* IMPORTANT: This utility requires that you copy the *
'* AcctCrt.dll to the %systemroot%\system32 directory *
'* on a computer where you plan to run this utility *
'* and that you register the dll on the computer by * *
'* typing: regsvr32 acctcrt.dll. *
'* The source files for this dll are available on the *
'* Exchange 5.5 SDK and you can download a compiled *
'* version of the dll for x86 platforms from Penton *
'* Media's Exchange and Outlook Administrator site *
'********************************************************************
Option Explicit
'This constant defined here because it's used by both the
'createmailbox and create AD user account routine
Const LDAP_ALREADY_EXISTS = &h80071392
Dim objArgs
Dim strAcctType,strUser,strDomain
Dim strContainer,strFirstName,strLastName
'Use Named Arguments collection for command line arguments
'The named element requires WSH version 5.6
Set objArgs = WScript.Arguments.Named
strAcctType = objArgs.Item("a")
strUser = objArgs.Item("u")
strDomain = objArgs.Item("d")
strContainer = objArgs.Item("c")
strFirstName = objArgs.Item("f")
strLastName = objArgs.Item("l")
If UCase(WScript.Arguments.Named.Item("a")) = "NT" Then
'For a Windows NT User Account
If WScript.Arguments.Named.Count < 5 Then
WScript.Arguments.ShowUsage
WScript.Quit
End If
If WScript.Arguments.Named.Exists("u") AND _
WScript.Arguments.Named.Exists("d") AND _
WScript.Arguments.Named.Exists("f") AND _
WScript.Arguments.Named.Exists("l") Then
Call CreateNTDomainUser()
Else
WScript.Arguments.ShowUsage
WScript.Quit
End If
ElseIf UCase(WScript.Arguments.Named.Item("a")) = "AD" Then
'For an AD User Account
If WScript.Arguments.Named.Count < 6 Then
WScript.Arguments.ShowUsage
WScript.Quit
End If
If Not WScript.Arguments.Named.Exists("c") Then
WScript.Echo "You must specify the distinguished name" & VbCrLf & _
"of the container (typically an OU) where you want" & VbCrLf & _
"the user account to be created. For example, to" & VbCrLf & _
"create a user account in an OU named HR in the" & VbCrLf & _
"adatum.com domain, type: /c:ou=hr,dc=adatum,dc=com"
WScript.Arguments.ShowUsage
WScript.Quit
End If
If WScript.Arguments.Named.Exists("u") AND _
WScript.Arguments.Named.Exists("d") AND _
WScript.Arguments.Named.Exists("f") AND _
WScript.Arguments.Named.Exists("l") Then
Call CreateADDomainUser()
Else
WScript.Arguments.ShowUsage
WScript.Quit
End If
Else
WScript.Arguments.ShowUsage
WScript.Quit
End If
Call CreateMailbox()
If UCASE(strAcctType) = "AD" Then
WScript.Echo "The " & UCASE(strUser) & _
" user account was created in the" & VbCrLf & _
strContainer & " container."
ElseIf UCASE(strAcctType) = "NT" Then
WScript.Echo "The " & UCASE(strDomain) & _
"\" & UCASE(strUser) & _
" user account was created."
End If
WScript.Echo "The " & strFirstName & " " & strLastName & _
" mailbox is assigned to the user account."
Sub CreateNTDomainUser()
Const WINNT_ALREADY_EXISTS = &h800708B0
'Declare local variables
Dim objDomain,objUser
Set objDomain = GetObject("
WinNT://" & strDomain)
Set objUser = objDomain.Create("user", strUser)
On Error Resume Next
objUser.SetInfo
If Err.number = WINNT_ALREADY_EXISTS Then
WScript.Echo "The " & UCASE(strDomain) & _
"\" & UCASE(strUser) & _
" user account already exists." & VbCrLf & _
"This utility creates both a user account and a mailbox."
WScript.Quit
End If
On Error GoTo 0
'Use the SetPassword method of IADsUser to set a password
'for the user account
objUser.SetPassword "asdf"
objUser.Put "FullName", strFirstName & " " & strLastName
objUser.Put "Description", "Exchange 5.5 Enabled User Account"
'Save the user account to the SAM database of the NT domain
objUser.SetInfo
End Sub
Sub CreateADDomainUser()
'Define a local constant
Const ADS_UF_ACCOUNTDISABLE = 2
Const LDAP_NO_SUCH_OBJECT = &h80072030
'Declare local variables
Dim objContainer,objUser,intUAC
On Error Resume Next
Set objContainer = GetObject("
LDAP://" & strContainer)
If Err.number = LDAP_NO_SUCH_OBJECT Then
WScript.echo "The container: " & _
strContainer & VbCrLf & _
"does not exist in the " & strDomain & _
" domain." & VbCrLf & _
"Check the value you specified for the /c: parameter."
WScript.Quit
End If
On Error GoTo 0
Set objUser = objContainer.Create("user","cn=" & strUser)
objUser.Put "sAMAccountName", strUser
On Error Resume Next
objUser.SetInfo
If Err.number = LDAP_ALREADY_EXISTS Then
WScript.Echo "The " & UCASE(strUser) & _
" user account already exists in the" & VbCrLf & _
strContainer & " container." & VbCrLf & _
"This utility creates both a user account and a mailbox."
WScript.Quit
End If
On Error GoTo 0
objUser.SetPassword "asdf"
objUser.Put "givenName",strFirstName
objUser.Put "sn",strLastName
objUser.Put "Description", "Exchange 5.5 Enabled User Account"
objUser.Put "userPrincipalName",strUser
'enable the user account
intUAC = objUser.Get("userAccountControl")
objUser.Put "userAccountControl", _
intUAC XOR ADS_UF_ACCOUNTDISABLE
'Save the user account to the Active Directory db
objUser.SetInfo
End Sub
Sub CreateMailbox()
'Define a local constants
Const DelivExtContentTypes = "2A864886F7140501"
Const ComponentCreateFailed = 429
Const ADS_PROPERTY_APPEND = 3
'Declare local variables
Dim strEx55SrvrName,strMailBoxPath
Dim objMBContainer,objMB
Dim strDisplayName
Dim intOUStart,intEndOfSiteName,strSite,strOrg
Dim objAcctMgmt,arrSID,arrSD
Dim strCountry,strAdminDomain,strX400Addr
Dim strSMTPAddr,strCCMailAddr,strMSMailAddr
Dim strMDB,strMTA
Dim objDomain,objContainer
'Initialize local variablels
'Change this value to the NetBIOS name of your Exchange 5.5 mail server
strEx55SrvrName = "NTS1" '***CHANGE VALUE***
'Change this value to the mailbox path where you want mailboxes created
strMailBoxPath = "o=NDG/ou=CONTOSO/cn=Recipients" '***CHANGE VALUE***
strDisplayName = strFirstName & " " & strLastName
'Extract the site name from the strMailBoxPath variable
intOUStart = InStr(1,strMailBoxPath,"ou=")
intEndOfSiteName = Instr(intOUStart,strMailBoxPath,"/")
strSite = UCase(Mid(strMailBoxPath,intOUStart + _
3,intEndOfSiteName - (intOUStart + 3)))
'Can use the strMailBox path string but you can also use defaultNamingContext
'of the RootDSE object of the Exchange Server to extract the organization name.
strOrg = UCase(Mid(sADsPath("defaultNamingContext",strEx55SrvrName),3))
'SMTP address
strSMTPAddr = strUser & "@" & strSite & ".com"
strCountry = "US"
'The "a" value name in the x.400 address is the
'administrative management domain, which is blank by default.
strAdminDomain = " "
'X400 address
strX400Addr = "c=" & strCountry & ";" & _
"a=" & strAdminDomain & ";" & _
"p=" & strOrg & ";" & _
"o=" & strSite & ";" & _
"s=Entry;" & _
"g=" & strUser & ";"
'Create the AcctMgmt class to obtain the sid of the user account
'and generate a security descriptor for the mailbox
On Error Resume Next
Set objAcctMgmt = CreateObject("MSExchange.AcctMgmt")
If Err.number = ComponentCreateFailed Then
WScript.Echo "The AcctCrt.dll is not available." & VbCrLf & _
"Copy the AcctCrt.dll included with this script to the " & VbCrLf & _
"%systemroot%\system32 folder on this computer and at the" & VbCrLf & _
"command prompt, type regsvr32 acctcrt.dll and press Enter."
On Error GoTo 0
'Delete the user account created by this script
If UCASE(strAcctType) = "NT" Then
Set objDomain = GetObject("
WinNT://" & strDomain)
objDomain.Delete "user", strUser
WScript.Echo VbCrLf & UCASE(strDomain) & "\" & UCASE(strUser) & _
VbCrLf & "has been deleted because the " & _
"create mailbox routine failed."
ElseIf UCASE(strAcctType) = "AD" Then
Set objContainer = GetObject("
LDAP://" & strContainer)
objContainer.Delete "user", "cn=" & strUser
WScript.Echo VbCrLf & UCASE(strUser) & " in the " & strContainer & _
VbCrLf & "has been deleted because the " & _
"create mailbox routine failed."
End If
WScript.quit
End If
'Get the SID of the user account
Call objAcctMgmt.GetSidFromName(strDomain,strUser,arrSID)
'Create a security descriptor for the mailbox
Call objAcctMgmt.GenerateSecDescriptor(strDomain,strUser,arrSD)
'Clean up
Set objAcctMgmt = Nothing
'Set an object reference to the path of the container
'where the mailbox will be created.
Set objMBContainer = GetObject("
LDAP://" & _
strEx55SrvrName & "/" & strMailBoxPath)
'Call the Create method to create the mailbox
Set objMB = objMBContainer.Create("OrganizationalPerson", "cn=" & strUser)
'These attributes are required.
'The required Delivery-Mechanism attribute
objMB.Put "mailPreferenceOption",0
'The last name or surname of a user is required by the Person class
objMB.Put "sn", strLastName
'End required attributes
'Deliv-Ext-Cont-Types is defined as optional in the Exchange schema
'for the organizational-person and Person classes but it's necessary
'to allow the mailbox to convert
'incoming X.400 messages to Exchange Server mail format.
objMB.Put "Deliv-Ext-Cont-Types", DelivExtContentTypes
'Set the cn attribute so that the user appears
'in the mailbox container with the default columns that are
'displayed in the Exchange Administrator.
objMB.Put "cn", strDisplayName
'Assign the SID and security descriptor to the mailbox.
'Note, the quotes surrounding the arrSID and arrSD are
'required.
objMB.Put "Assoc-NT-Account",(arrSID)
objMB.Put "NT-Security-Descriptor",(arrSD)
'The uid attribute is the Alias Name attribute
'It appears in the Alias description field in the properties
'of a user account.
objMB.Put "uid", strUser
'Assign an x.400 address
objMB.Put "textEncodedORAddress", strX400Addr
'Assign an smtp address. Can be either "mail" or "rfc822Mailbox".
'This example uses "mail"
objMB.Put "mail", strSMTPAddr
'Assign a ccMail address
strCCMailAddr = "CCMAIL$Entry," & strUser & " at " & strSite
'Assign a MSMail address
strMSMailAddr = "MS$" & strOrg & "/" & strSite & "/" & strUser
'otherMailbox attribute is multi-valued so add using PutEx
'and ADS_PROPERTY_APPEND constant
objMB.PutEx ADS_PROPERTY_APPEND,"otherMailBox", _
Array(strCCMailAddr,strMSMailAddr)
'These attributes are included so that the mailbox created with this utility
'match mailboxes created manually.
objMB.Put "MDB-Use-Defaults",True
objMB.Put "Replication-Sensitivity",20
objMB.Put "MAPI-Recipient", True 'This allows for rich text messaging
'This adds an entry in the Home server field at the bottom
'of the General tab of a user account's mailbox
strMDB = "cn=Microsoft Private MDB,cn=" & strEx55SrvrName & _
",cn=Servers,cn=Configuration,ou=" & strSite & ",o=" & strOrg
objMB.Put "Home-MDB", strMDB
'Associate the mailbox with a message transfer agent (MTA).
strMTA = "cn=Microsoft MTA,cn=" & strEx55SrvrName & _
",cn=Servers,cn=Configuration,ou=" & strSite & ",o=" & strOrg
objMB.Put "Home-MTA", strMTA
'Assign additional attributes to match your mailbox
'creation policies. For example:
objMB.Put "givenName", strFirstName
'Save the mailbox to the Exchange 5.5 directory
On Error Resume Next
objMB.SetInfo
If Err.number = LDAP_ALREADY_EXISTS Then
WScript.Echo "The mailbox for " & _
UCase(strUser) & " already exists."
WScript.Quit
End If
On Error GoTo 0
End Sub
'Resolve organization name.
Function sADsPath(Attrib,MailServer)
'Declare local variables.
Dim oRootDSE
'Initialize local variables.
Set oRootDSE = GetObject("
LDAP://" & MailServer & "/rootDSE")
sADsPath = oRootDSE.Get(Attrib)
Set oRootDSE = Nothing
End Function
Ny bruger
Nybegynder
Opret
Preview
