Problems creating an exchange mailbox and setting permissions

Hi All,

I hope someone can help.

I am having problems accessing the Security Descriptor when creating a
New User. It errors telling me an object is required with error 424.
I have this working on other infrastructures the same as it is in this
code and therefore can not understand why it is not working.
The bit of the code which is failing is the Function to Create The
Exchange Mailbox the rest is working fine.

Here is the code

---------------------------------------------------------------------------------------------------------------------------------------------------------------------
<HTML>
<HEAD>
<TITLE>New User Creation Utility</TITLE>
<HTA:APPLICATION ID="oCreateAccount"
APPLICATIONNAME="AccountCreationScript"
BORDER="thin"
CAPTION="yes"
ICON="SETUP.ICO"
SHOWINTASKBAR="yes"
SINGLEINSTANCE="yes"
SCROLL="NO"
SYSMENU="yes"
WINDOWSTATE="normal"
MAXIMIZEBUTTON="no"
MINIMIZEBUTTON="yes">
</HEAD>

<style>
BODY
{
background-color: "#E4EAF6";
font-family: Helvetica;
font-size: 14pt;
color: "#000080";
margin-top: 5%;
margin-left: 5%;
margin-right: 5%;
margin-bottom: 5%;
}
</STYLE>
<SCRIPT LANGUAGE="VBScript">
<!--
'=================================================================================================================================================
'***When the Script window loads set the size and location of the
window.***
'=================================================================================================================================================
sub Window_Onload

self.focus()
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer &
"\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * From
Win32_DesktopMonitor")
For Each objItem in colItems
intHorizontal = objItem.ScreenWidth
intVertical = objItem.ScreenHeight
Next
intLeft = (intHorizontal - 800) / 2
intTop = (intVertical - 600) / 2
window.resizeTo 800,600
'window.moveTo intLeft, intTop
btnRunScript.disabled = false
btnReset.disabled = false
btnClose.disabled = false

end sub
'=================================================================================================================================================
'***Clear any stored Values from the entry fields.***
'=================================================================================================================================================
sub btnReset_Click
txtFirstname.value = ""
txtMiddlename.value = ""
txtLastname.value = ""
txtRefnumber.value = ""
txtRequestor.value = ""
ListAccType.value = "AccTypeStart"
btnRunScript.disabled = false
btnReset.disabled = false
btnClose.disabled = false
end sub
'=================================================================================================================================================
'***Collect information for new user entered by the Administrator.***
'=================================================================================================================================================
sub btnRunScript_click
firstname=txtFirstname.value
middlename=txtMiddlename.value
lastname=txtLastname.value
referencenumber=txtRefnumber.value
Requestor=txtRequestor.value
AccountType=ListAccType.value

'Formatting the text to make sure that the details are correct
firstname=UCASE(left(firstname,1))+LCASE(mid(firstname,2))
middlename=UCASE(left(middlename,1))+LCASE(mid(middlename,2))
If mid(lastname,2) = "'" Then
lastname=UCASE(left(lastname,3))+LCASE(mid(lastname,4))
Else
lastname=UCASE(left(lastname,1))+LCASE(mid(lastname,2))
End If

btnRunScript.disabled = true
btnReset.disabled = true
btnClose.disabled = true

if firstname="" then
msgbox "Please enter the users First Name"
btnRunScript.disabled = false
btnReset.disabled = false
btnClose.disabled = false
exit sub
elseif lastname = "" then
msgbox "Please enter the users Surname"
btnRunScript.disabled = false
btnReset.disabled = false
btnClose.disabled = false
exit sub
elseif referencenumber = "" then
msgbox "Please enter the Reference Number"
btnRunScript.disabled = false
btnReset.disabled = false
btnClose.disabled = false
exit sub
elseif Requestor = "" then
msgbox "Please enter the Requestor's Name"
btnRunScript.disabled = false
btnReset.disabled = false
btnClose.disabled = false
exit sub
elseif AccountType = "AccTypeStart" then
msgbox "Please select the Account Type"
btnRunScript.disabled = false
btnReset.disabled = false
btnClose.disabled = false
exit sub
else
'do nothing
end if

call
createAccount(firstname,middlename,lastname,referencenumber,Requestor,AccountType)

end sub
'=================================================================================================================================================
'***Collect information for new user entered by the Administrator,
then create the account.***
'=================================================================================================================================================
sub
createAccount(firstname,middlename,lastname,referencenumber,Requestor,AccountType)
'On error resume next

intAccValue = 544
inputdomain="Domain"
inputou="OU"
Set wshshell = CreateObject("wscript.shell")
username = wshshell.expandenvironmentstrings("%username%")
strDomain="Domain.Com"
CurrDateTime=now
firstinitial = UCASE(left(firstname,1))
strFile = "filepath"
strExServer = "Servername"
strProfPath = "\\Servername\User$\P"
strHomeDir = "\\Servername\User$\H"
strTempPath = strHomeDir & firstinitial & "\_Template\"

msgbox "Please verify the following details of the account to create"
& VBCRLF & "Firstname: " & firstname & VBCR & "Middlename: " &
middlename & VBCR & "Lastname: " & lastname & VBCR & "Reference
Number: " & referencenumber

MsgboxResult=msgbox("Is this information correct?",
259,"Confirmation")

if MsgboxResult = 7 then
txtFirstname.value = ""
txtMiddlename.value = ""
txtLastname.value = ""
txtRefnumber.value = ""
ListAccType.value = "AccTypeStart"
btnRunScript.disabled = false
btnReset.disabled = false
btnClose.disabled = false
exit sub
elseif MsgboxResult = 2 then
window_close
exit sub
else
'do nothing
end if

'Connect to the usersdatabase to get sitedetails and record the
transaction

set conn=createobject("adodb.connection")
conn.connectiontimeout = 30000
conn.commandtimeout=30000
set myset=createobject("adodb.recordset")
conn.open "Driver={Microsoft Access Driver
(*.mdb)};Dbq=UserAdmin.mdb;"
sql="select * from Exchange where exchangeserver='" & strExServer &
"'"
'Msgbox sql
set myset=conn.execute(sql)

exchangeserver=myset("exchangeServer")
storagegroup1=myset("storagegroup1")
storagegroup2=myset("storagegroup2")
informationstore1=myset("informationstore1")
informationstore2=myset("informationstore2")
informationstore3=myset("informationstore3")
informationstore4=myset("informationstore4")
informationstore5=myset("informationstore5")
informationstore6=myset("informationstore6")
informationstore7=myset("informationstore7")
informationstore8=myset("informationstore8")
informationstore9=myset("informationstore9")

'Create a temporary account name

testusername=UCASE(left(firstname,1) & left(middlename,1) &
left(lastname,1)) & LCASE(mid(lastname,2))

'Check if there is an account with this name already

nameok=testaccount(testusername)

if nameok=0 then
' The account name is already in use, need to alter the name used
msgbox "This Account name is already in use, there is a duplicate
entry." & VBCRLF & "Please verify the details entered, you will need
to start again once the details have been verified."
txtFirstname.value = ""
txtMiddlename.value = ""
txtLastname.value = ""
txtRefnumber.value = ""
txtRequestor.value = ""
ListAccType.value = "AccTypeStart"
btnRunScript.disabled = false
btnReset.disabled = false
btnClose.disabled = false
exit sub
else
' This name is free so use it
end if

'Now we create the base user account so that we can assign properties
to it

objectname="LDAP://ou=users,ou="; & inputou & ",dc=" & inputdomain &
",dc=COM"

'Now we create the new user account so that we can set its properties

Set ou = GetObject(objectname)
'Have to remember to escape the , by preceeding it with a \, so
smith, john becomes smith\, john this still shows as smith, john in
the gui though.

If middlename = "" Then
fullname="cn=" & firstname & " " & lastname
Else
fullname="cn=" & firstname & " " & middlename & " " & lastname
End If

Set usr = ou.Create("user", fullname)
usr.Put "samAccountName", testusername
usr.SetInfo
usr.lastname = lastname
usr.givenname = firstname

if len(middlename)>0 then
usr.initials=left(middlename,1)
end if

usr.setinfo
usr.userPrincipalName=testusername & "@" & inputdomain & ".co.uk"

If middlename = "" Then
usr.displayname=firstname & " " & lastname
Else
usr.displayname=firstname & " " & middlename & " " & lastname
End If

usr.description=AccountType
usr.setinfo
usr.profilepath=strProfPath & firstinitial & "\" & testusername
usr.homedrive="P:"
usr.homedirectory=strHomeDir & firstinitial & "\" & testusername
usr.SetInfo
usr.info="Created via script by " & username & " on " & now & " Ref:
" & referencenumber & VBTAB & "Requested by: " & Requestor
usr.SetInfo
usr.Put "userAccountControl", intAccValue
usr.setinfo

homedir = usr.homedirectory
profiledir = usr.profilepath

'Now we need to create the homedrive and profilepath for the account

set fso=createobject("scripting.filesystemobject")

if fso.folderexists(usr.homedirectory) then
msgbox "There is already a home directory for this user. Please
verify it is correct and with the correct permissions"
else
set f=fso.createfolder(usr.homedirectory)
end if

if fso.folderexists(usr.profilepath) then
msgbox "There is already a profile directory for this user. Please
verify it is correct and with the correct permissions"
else
set f=fso.createfolder(usr.profilepath)
end if

'And set the permissions

cmdline="cmd /c setacl.exe -on " & homedir & " -ot file -actn ace -
ace " & "n:" & inputdomain & "\" & testusername &
";p:full;s:n;i:sc,so;m:grant;w:dacl"
cmdline1="cmd /c setacl.exe -on " & profiledir & " -ot file -actn
ace -ace " & "n:" & inputdomain & "\" & testusername &
";p:full;s:n;i:sc,so;m:grant;w:dacl"

Set WshShell = CreateObject("WScript.Shell")

poi=wshshell.run(cmdline)

poi1=wshshell.run(cmdline1)

'Copy the _Template folder and it's contents to the Users Home Folder
fso.CopyFolder strTempPath & "*.*", homedir, True

'Now we enable the account

res=addgroups(inputdomain,testusername,AccountType)

strDate = now

'get numeric value for day of the week
myDayName = WeekDay(strDate)

'convert numeric value to day name
myDayName = WeekDayName(myDayName)

DayofWeek = LCASE(myDayName)

CurrentDay = Dayofweek

usr.Accountdisabled=0
strPassword=CurrentDay
usr.setpassword strPassword
usr.put "pwdLastSet", 0
usr.setinfo

'Now we create the mailbox

'***First convert the first character of the firstname into an ascii
code***
'***In order to sort the user into the correct Information
Store ***

FirstChar= "H"

FirstCharAsci=Asc(FirstChar)

AsciA=Asc("A")
AsciB=Asc("B")
AsciC=Asc("C")
AsciD=Asc("D")
AsciE=Asc("E")
AsciF=Asc("F")
AsciG=Asc("G")
AsciH=Asc("H")
AsciI=Asc("I")
AsciJ=Asc("J")
AsciK=Asc("K")
AsciL=Asc("L")
AsciM=Asc("M")
AsciN=Asc("N")
AsciO=Asc("o")
AsciP=Asc("P")
AsciQ=Asc("Q")
AsciR=Asc("R")
AsciS=Asc("S")
AsciT=Asc("T")
AsciU=Asc("U")
AsciV=Asc("V")
AsciW=Asc("W")
AsciX=Asc("X")
AsciY=Asc("Y")
AsciZ=Asc("Z")

Call RUS

strAlias=UCASE(Left(firstname,1) & left(middlename,1) & left(lastname,
1)) & LCASE(Left(lastname,2))

smtpok = testsmtp(firstname,middlename,lastname,inputdomain,strAlias)

If smtpok = 0 Then
strAlias=UCASE(Left(firstname,1) & left(middlename,1) &
left(lastname,1)) & LCASE(lastname,2) & "X"
smtpok =
testsmtp(firstname,middlename,lastname,inputdomain,strAlias)
If smtpok = 0 Then
strAlias=UCASE(Left(firstname,1) & left(middlename,1) &
left(lastname,1)) & LCASE(lastname,2) & "XX"
smtpok =
testsmtp(firstname,middlename,lastname,inputdomain,strAlias)
If smtpok = 0 Then
strAlias=UCASE(Left(firstname,1) & left(middlename,1) &
left(lastname,1)) & LCASE(lastname,2) & "XXX"
smtpok =
testsmtp(firstname,middlename,lastname,inputdomain,strAlias)
If smtpok = 0 Then
strAlias=UCASE(Left(firstname,1) & left(middlename,1) &
left(lastname,1)) & LCASE(lastname,2) & "XXXX"
Else
'Do Nothing
End If
Else
'Do Nothing
End If
Else
'Do Nothing
End If
Else
'Do Nothing
End If

'Call ChangeSmtpAddress(strAlias,fullname,site,inputdomain,inputou)

If FirstCharAsci >= AsciA AND FirstCharAsci <= AsciB then
storagegroup=storagegroup1
informationstore=informationstore1
ElseIf FirstCharAsci >= AsciC AND FirstCharAsci <= AsciD then
storagegroup=storagegroup1
informationstore=informationstore2
ElseIf FirstCharAsci >= AsciE AND FirstCharAsci <= AsciH then
storagegroup=storagegroup1
informationstore=informationstore3
ElseIf FirstCharAsci >= AsciI AND FirstCharAsci <= AsciK then
storagegroup=storagegroup1
informationstore=informationstore4
ElseIf FirstCharAsci >= AsciL AND FirstCharAsci <= AsciM then
storagegroup=storagegroup2
informationstore=informationstore5
ElseIf FirstCharAsci >= AsciN AND FirstCharAsci <= AsciP then
storagegroup=storagegroup2
informationstore=informationstore6
ElseIf FirstCharAsci >= AsciQ AND FirstCharAsci <= AsciS then
storagegroup=storagegroup2
informationstore=informationstore7
ElseIf FirstCharAsci >= AsciT AND FirstCharAsci <= AsciZ then
storagegroup=storagegroup2
informationstore=informationstore9
Else
storagegroup=storagegroup2
informationstore=informationstore8
End if


'***Build the LDAP url in order to create the mailbox'***
strLDAPUrl="LDAP://CN="; & informationstore & ",CN=" & storagegroup &
",CN=InformationStore,CN=" & _
exchangeserver & ",CN=Servers,CN=Admin Group,CN=Administrative
Groups,CN=" & inputdomain & _
",CN=Microsoft
Exchange,CN=Services,CN=Configuration,dc=Domain,dc=COM"

bContinue=CreateNewUserMailbox(usr, strLDAPUrl, inputdomain,
testusername)

If bContinue=True then
bContinue2=CreateMailboxFolders(exchangeserver, strAlias,
strPassword)
Else
msgbox "Failed to create Mailbox for this user, please create it
manually"
End If

'write out DB information

set dbupdaters=createobject("adodb.recordset")
dbupdaters.open "Users",conn,2,2,2
dbupdaters.addnew
dbupdaters("firstname")=firstname
dbupdaters("middlename")=middlename
dbupdaters("lastname")=lastname
dbupdaters("accounttype")=AccountType
dbupdaters("homeserver")=homedir
dbupdaters("storagegroup")=storagegroup
dbupdaters("informationstore")=informationstore
dbupdaters("UserID")=testusername
dbupdaters("creator")=username
dbupdaters("Domain")=inputdomain
dbupdaters("Creation Time")=now

dbupdaters.update

txtFirstname.value = ""
txtMiddlename.value = ""
txtLastname.value = ""
txtRefnumber.value = ""
txtRequestor.value = ""
ListAccType.value = "AccTypeStart"

msgbox "Account has been created successfully."
MsgBox "Account Username is: " & testusername & VBCRLF & "Account
Password is: " & strPassword & VBCRLF & "Home Server: " & _
homedir & VBCRLF & "Profile Directory: " & profiledir

set dbupdaters=nothing
set conn=nothing
Set strPassword=nothing

btnRunScript.disabled = false
btnReset.disabled = false
btnClose.disabled = false

end sub
'=================================================================================================================================================
'***Sub and Function to Initiate the Recipient Update Service and
force replication.***
'=================================================================================================================================================
Sub RUS

'This sample finds the first Exchange Organization and
'starts the server RUS. If you have multiple Exchange
'organizations you will want to modify the code.
'This sample does a serverless bind finding the first DC
'to respond. You may want to modify the code to specify
'a specific server in the Bind statement.

Dim RootDse
Set RootDse = GetObject("LDAP://RootDSE";)
strdn = RootDse.Get("defaultNamingContext")
Set oConfig = GetObject("LDAP://"; & strdn)
strDomainName = oConfig.Get("name")
strConfigurationNC = RootDse.Get("ConfigurationNamingContext")
strExchangeOrg = FindAnyOrg(strConfigurationNC)
strRUS = "CN=Recipient Update Service (" & strDomainName &
"),CN=Recipient Update Services," & "CN=Address Lists Container,CN=" &
strExchangeOrg & ",CN=Microsoft Exchange,CN=Services," &
"CN=Configuration," & strdn
Set objRUS = GetObject("LDAP://"; & strRUS)
objRUS.Put "msExchReplicateNow", True
objRUS.SetInfo

End Sub

Function FindAnyOrg(strConfigurationNC)

Set oConnection = CreateObject("ADODB.Connection")
Set oCommand = CreateObject("ADODB.Command")
Set oRecordSet = CreateObject("ADODB.RecordSet")
Dim strQuery

'Open the Connection
oConnection.Provider = "ADsDSOObject"
oConnection.Open "ADs Provider"

'Build the query to find the private Exchange Organization
strQuery = "<LDAP://"; & strConfigurationNC & ">;
(objectCategory=msExchOrganizationContainer);name,adspath;subtree"
oCommand.ActiveConnection = oConnection
oCommand.CommandText = strQuery
Set oRecordSet = oCommand.Execute

'If we have an Organization then return the first one
If Not oRecordSet.EOF Then
oRecordSet.MoveFirst
FindAnyOrg = CStr(oRecordSet.Fields("name").Value)
Else
FindAnyOrg = ""
End If

'Clean Up
oRecordSet.Close
oConnection.Close
Set oRecordSet = Nothing
Set oCommand = Nothing
Set oConnection = Nothing

End Function
'=================================================================================================================================================
'***Sub to change the smtp address.***
'=================================================================================================================================================
Sub ChangeSmtpAddress(strAlias,fullname,site,inputdomain,inputou)

Set objUser = GetObject("LDAP://"; & fullname & ",OU=users,ou=" &
inputou & ",dc=" & inputdomain & ",dc=Local")

vProxyAddresses = objUser.proxyaddresses

sAddress = "SMTP:" & strAlias & "@" & inputdomain & ".co.uk"

nProxyAddresses = uBound(vProxyAddresses)

Do While (nProxyAddresses <> 2) or (IsNull(nProxyAddresses))

nProxyAddresses = uBound(vProxyAddresses)
vProxyAddresses = objUser.proxyaddresses
Loop

i = 0

Do While i <= nProxyAddresses
email = vProxyAddresses(i)
If Left (email,5) = "SMTP:" Then
ReDim Preserve vProxyAddresses(nProxyAddresses)
vProxyAddresses(nProxyAddresses) = sAddress
objUser.proxyaddresses = vProxyAddresses
objUser.SetInfo
End If
i = i + 1
Loop

objUser.Put "mail", strAlias & "@" & inputdomain & ".co.uk"

objUser.SetInfo

End Sub
'=================================================================================================================================================
'***Check SMTP Alias across the domain.***
'=================================================================================================================================================
function testsmtp(firstname,middlename,lastname,inputdomain,strAlias)
on error resume next

Set objCommand = CreateObject("ADODB.Command")
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
objCommand.ActiveConnection = objConnection

strBase = "<LDAP://ou="; & inputou & ",dc=" & inputdomain & ",dc=COM>"

strFilter = "(&(objectCategory=person)(proxyaddresses=SMTP:" &
strAlias & "@" & inputdomain & ".co.uk"))"
strAttributes = "proxyaddresses,AdsPath"
strQuery = strBase & ";" & strFilter & ";" & strAttributes
objCommand.CommandText = strQuery
Set ADSIRecordSet = objCommand.Execute
strProxy = ADSIRecordSet.Fields("proxyaddresses").Value

errorNum = err.number
errorDesc = err.description

if err.number = 0 then
testsmtp = 0
else
testsmtp = 1
end if

end function
'=================================================================================================================================================
'***Check User name across the domain.***
'=================================================================================================================================================
function testaccount(testusername)
on error resume next
'Check via the WinNT provider as we want the accounts to be unique
across the domain not the OU
set checkuser=getobject("WinNT://" & inputdomain & "/" & testusername
& ",User")
testaccount=err.number
end function
'=================================================================================================================================================
'***Add the user to the groups.***
'=================================================================================================================================================
function addgroups(inputdomain,testusername,AccountType)
On Error Resume Next

strGroup1 = "Group1"
strGroup2 = "Group2"
strGroup3 = "Group3"

strPermGroup = "Group4"

Set User = GetObject("WinNT://" & inputdomain & "/" & testusername &
",user")

Set Group = GetObject("WinNT://" & inputdomain & "/" & strGroup1 &
",group")
If Group.IsMember(User.AdsPath) = TRUE Then
'Do Nothing
Else
strMember = Group.Add(User.AdsPath)
End If

Set Group = GetObject("WinNT://" & inputdomain & "/" & strGroup2 &
",group")
If Group.IsMember(User.AdsPath) = TRUE Then
'Do Nothing
Else
strMember = Group.Add(User.AdsPath)
End If

Set Group = GetObject("WinNT://" & inputdomain & "/" & strGroup3 &
",group")
If Group.IsMember(User.AdsPath) = TRUE Then
'Do Nothing
Else
strMember = Group.Add(User.AdsPath)
End If

If AccountType = "Standard User Account" Then
Set Group = GetObject("WinNT://" & inputdomain & "/" & strPermGroup
& ",group")
If Group.IsMember(User.AdsPath) = TRUE Then
'Do Nothing
Else
strMember = Group.Add(User.AdsPath)
End If
Else
'Do Nothing
End If

end function
'=================================================================================================================================================
'***Create the new users exchange mailbox.***
'=================================================================================================================================================
Function CreateNewUserMailbox(usr, strLDAPUrl, inputdomain,
testusername)

usr.createmailbox strLDAPUrl
usr.setinfo

'Set the Delivery Size Limit for the User to 6Mb
usr.put "submissionContLength", "6144"
usr.SetInfo

Call RUS

sTrusteeName=inputdomain & "\" & testusername

'Get the copy Mailbox Security Descriptor (SD) stored on the
msExchMailboxSecurityDescriptor attribute

usr.GetInfoEx Array("msExchMailboxSecurityDescriptor"), 0
Set oSecurityDescriptor = usr.Get("msExchMailboxSecurityDescriptor")

'Extract the Discretionary Access Control List (ACL) using the
IADsSecurityDescriptor interface

Set dacl = oSecurityDescriptor.DiscretionaryAcl

MsgBox err.number & VBTAB & err.description

AddAce dacl, sTrusteeName, 131073, 0, 2, 0, 0, 0

'Add the modified DACL back onto the Security Descriptor

oSecurityDescriptor.DiscretionaryAcl = dacl

'Save New SD onto the user

usr.Put "msExchMailboxSecurityDescriptor", oSecurityDescriptor

'Commit changes from the property cache to the information store

usr.SetInfo

'MsgBox "Done viewing and modifying the copy of the Mailbox Security
Descriptor"

CreateNewUserMailbox = True

End Function
'=================================================================================================================================================
'***Create the mailbox folders.***
'=================================================================================================================================================
Function CreateMailboxFolders(exchangeserver, strAlias, strPassword)

CreateMailboxFolders = False

'Build the URL to the user's mailbox.
strMailboxURL = "http://"; & exchangeserver & "/Exchange/" & strAlias
& "/"

'Build the Domain\Username string.
strUserDomain = inputdomain + "\" + testusername

'Create the XMLHTTP object.
Set oXMLHTTP = CreateObject("microsoft.xmlhttp")

'Open the request object with the GET method. Specify the source
URI,
'that it will run asynchronously, and the username/password of the
'new user.
oXMLHTTP.Open "GET", strMailboxURL, False, strUserDomain, strPassword

'Set the language in which the mailbox folders will be created.
oXMLHTTP.setRequestHeader "Accept-Language", "en-us"
oXMLHTTP.setRequestHeader "Connection", "Keep-Alive"

'Send the GET method request. If the mailbox folders
'have not yet been created, this method will have the side
'effect of forcing the Exchange server to create them in
'the language specified in the "Accept-Language" header.
oXMLHTTP.Send ("")

If (oXMLHTTP.Status >= 200) And (oXMLHTTP.Status < 300) Then
msgbox "Mailbox folders for " & strAlias & " successfully created."
CreateMailboxFolders = True
Else
'GET method did not successfully force creation of mailbox folders.
CreateMailboxFolders = False
End If

Set oXMLHTTP = Nothing
End Function
'=================================================================================================================================================
'***Set the permissions to the mailbox for the user.***
'=================================================================================================================================================
Function AddAce(dacl, TrusteeName, gAccessMask, gAceType, gAceFlags,
gFlags, gObjectType, gInheritedObjectType, inputdomain, testusername)

'Create a new ACE object
Set Ace1 = CreateObject("AccessControlEntry")
Ace1.AccessMask = gAccessMask
Ace1.AceType = gAceType
Ace1.AceFlags = gAceFlags
Ace1.Flags = gFlags
Ace1.Trustee = inputdomain & "\" & testusername
'Check to see if ObjectType needs to be set
If CStr(gObjectType) <> "0" Then
Ace1.ObjectType = gObjectType
End If

'Check to see if InheritedObjectType needs to be set
If CStr(gInheritedObjectType) <> "0" Then
Ace1.InheritedObjectType = gInheritedObjectType
End If
dacl.AddAce Ace1

'Destroy objects
Set Ace1 = Nothing
End Function
'=================================================================================================================================================
'***Close the Script Window.***
'=================================================================================================================================================
sub window_close
window.parent.close
end sub
'=================================================================================================================================================
'***End of the Script.***
'=================================================================================================================================================
-->
</SCRIPT>
<BODY>
<P ALIGN = center>
<img src="C4.jpg" alt="C4"></P>
<BR>
<P ALIGN = center><STRONG>Welcome to the Account Creation Script</
STRONG></P>
<table width="100%" border="0">
<tr><td><table width="100%" border="0">
<tr><th COLSPAN=2><hr>Users Details<hr></th></tr>
<tr><td>First Name:</td><td><input type="text" id="txtFirstname"
size="30"></td></tr>
<tr><td>Middlename:</td><td><input type="text" id="txtMiddlename"
size="30"></td></tr>
<tr><td>Lastname:</td><td><input type="text" id="txtLastname"
size="30"></td></tr>
<tr><td>Reference Number:</td><td><input type="text"
id="txtRefnumber" size="30"></td></tr>
<tr><td>Requestor:</td><td><input type="text" id="txtRequestor"
size="30"></td></tr>
<tr><td>Please select the Account Type for this user account:</
td><td>
<select name = "ListAccType">
<option value="AccTypeStart">Please Select</option>
<option value="Standard User Account">Standard</option>
<option value="Fixed Term Contract User Account">Fixed Term
Contract</option>
<option value="Non-Person User Account">Non-Person Account</
option>
</select>
</td></tr>
</table>
</td></tr>
<tr><td>&nbsp;</td><td>&nbsp;</td></tr>
<tr><td><P ALIGN = center><input type="button" id="btnRunScript"
value="Create Account" onclick="btnRunScript_click"><input
type="button" id="btnReset" value="Reset"
onclick="btnReset_Click"><input type="button" id="btnClose"
value="Close" onclick="window_close"></P></td></tr>
<tr><td></tr></td>
</table>
</BODY>
</HTML>
---------------------------------------------------------------------------------------------------------------------------------------------------------------------
Many Thanks In Advance

.