Link to home
Start Free TrialLog in
Avatar of bsharath
bsharathFlag for India

asked on

Create users and mailboxes from a excel

Hi,

I want to create all users and mailboxes that i have in a excel sheet.

This Q is a continuation of this.
https://www.experts-exchange.com/questions/22804838/Need-to-create-users-in-ADS-from-the-excel-file.html

Regards
SHarath
Avatar of chandru_sol
chandru_sol
Flag of India image

Hi Sharath,

Do you want to create users and there mailboxes from Excel?

regards
Chandru
Avatar of bsharath

ASKER

Yes Chandru
Chandru in the above link i think Rob was mentioning about you.Did the Hta file work?
Chandru did you get the Hta script working which you and Rob worked on...
If yes can you share the working code.I can raise a Q for it...
Rob was telling me that he does not know if the code worked for you and he does not have an exchange to test...
Avatar of RobSampson
Hey Chandru, how are you?
Looks like we may have a chance to put our ideas together here.....Chandru, I will await your response...As Sharath has mentioned, I am not sure whether the HTA code (or just the Exchange mailbox creation) was working properly.

Regards,

Rob.
Hi Rob,
Nice meeting you once again. I didn't get a chance to test the HTA. I was about to work with you to make further improvements on the script.

I will test this today and will post the results in the morning tomorrow?

sharath - Sorry for the delay in reply. Was very busy from morning...

regards
Chandru
Ok chandru.I hope you and Rob can get a extremely Good stuff togeather
chandru_sol

Any chance of you checking ?
Sharath,

I will post the code as i didn't get a chance to test the code.

Sorry guys!
Ok Chandru awaiting for it
Hi Sharath,

Sorry for the delay.....
Here is the code for that HTA which myself and Rob were working a month before.

Rob - We will be requiring your assistance asusual to get this script completed

Code starts here
<html>
<head>
<title>Eroom User Account Creation Form v1.0</title>
<HTA:APPLICATION
ID = "AccountCreationApp"




      VERSION="1.0"
      APPLICATIONNAME="AD Account Creation"
      SYSMENU="yes"
      MAXIMIZEBUTTON="yes"
      MINIMIZEBUTTON="yes"
      BORDER="thin"
      INNERBORDER="no"
      SCROLL="auto"
      SINGLEINSTANCE="yes"
      WINDOWSTATE="maximize"
>
</hta>
<style>
BODY
{
background-color: #008B8B;
font-family: Helvetica;
font-size: 8pt;
margin-top: 10px;
margin-left: 20px;
margin-right: 10px;
margin-bottom: 10px;



}
TD
{
font-family: Trebuchet MS;
font-size: 8pt;
}
LEGEND
{
font-family: Trebuchet MS;
font-size: 10pt;
}
SELECT
{
font-family: Trebuchet MS;
font-size: 8pt;
width:195px
}
INPUT
{
font-family: Trebuchet MS;
font-size: 8pt;
}
</style>


<script language="VBScript">
Dim defaultNC, BaseOU
defaultNC = GetObject("LDAP://RootDSE").Get("DefaultNamingContext")
BaseOU = "OU=Domain Clients," & defaultNC
Logpath ="C:\logs\"
Const FORAPPENDING = 8

Sub Window_OnLoad
Dim width, height, x, y
width = 800
height = 620
x = (window.screen.width - width) / 2
y = (window.screen.height - height) / 2
If x < 0 Then x = 0
If y < 0 Then y = 0
window.resizeTo width,height
window.moveTo x,y
'Check if this HTA is running under the correct account
Set wshNetwork = CreateObject("WScript.Network")
strComputer = wshNetwork.ComputerName
strCurrentDomain = wshNetwork.UserDomain
strCurrentUser = wshNetwork.UserName
span_Logo.InnerHTML = "<img src='Active-Directory-Management.jpg' height=100 width=200><br><br>"
span_User.InnerHTML = "<br><br><br><br><br><font size='1' color='White'>Currently running program as:<b>" & strCurrentDomain & "\" & strCurrentUser & "</b></font><br><br>"
strRequiredDomain = "Domainname"
strRequiredUser = "Domainadminusername"
strHTAPath = Replace(Mid(Document.URL, 8), "%20", " ")
If Left(strHTAPath, 2) <> "\\" And Left(strHTAPath, 2) <> "C:" Then
      MsgBox "Please run this program from a local drive or a UNC path"
      Window.Close
      Exit Sub
End If
Set objFSO = CreateObject("Scripting.FileSystemObject")
If LCase(strRequiredDomain & "\" & strRequiredUser) <> LCase(strCurrentDomain & "\" & strCurrentUser) Then
      strRequiredPassword = InputBox("This program is not running under the user account of " & strRequiredDomain & "\" & strRequiredUser & "." & VbCrLf &_
            "Please enter the password for the required account, and the program will be restarted:", "Incorrect User")
      strPSExecPath = "\\server\Scripts\psexec.exe"
      strCommand = "cmd /c " & objFSO.GetFile(strPSExecPath).ShortPath & " -accepteula \\" & strComputer & " -i -d -u " & strRequiredDomain & "\" & strRequiredUser & " -p " & strRequiredPassword & " mshta.exe " & objFSO.GetFile(strHTAPath).ShortPath
      'InputBox "Prompt", "Title", strCommand
      Set objShell = CreateObject("WScript.Shell")
      objShell.Run strCommand, 0, False
      Window.Close
End If
Call Populate_Office
Call Populate_Domain_Controllers
Call Populate_Exchange_Servers
End Sub

Sub Populate_Office()

      strHTML = "<select size='1' name='cbxSite'>" & VbCrLf

      Set objFSO = CreateObject("Scripting.FileSystemObject")
      strRootPath = Replace(Mid(Document.URL, 8), "%20", " ")
      strRootPath = Left(strRootPath, InStrRev(strRootPath, "\"))
      strOfficeFile = strRootPath & "OfficeLocations.txt"
      If objFSO.FileExists(strOfficeFile) = False Then
            MsgBox strOfficeFile & " not found.  Cannot create Office Locations."
            Exit Sub
      End If
     
      Set objOfficeFile = objFSO.OpenTextFile(strOfficeFile, 1, False)
      While Not objOfficeFile.AtEndOfStream
            strOffice = objOfficeFile.ReadLine
            If strOffice <> "" Then
                  strHTML = strHTML & "<option value='" & strOffice & "'>" & strOffice & "</option>" & vbCrLf
            End If
      Wend
      objOfficeFile.Close
     
      strHTML = strHTML & "<option selected value='cbxOfficeAlert'>-- Select Users Office --</option>" & vbCrLf
      strHTML = strHTML & "</select>"

      span_Office.InnerHTML = strHTML
     
      Set objOfficeFile = Nothing
      Set objFSO = Nothing
End Sub

Sub Populate_Domain_Controllers()

      strHTML = "<select size='1' name='cbxDCServer'>" & VbCrLf
      strHTML = strHTML & "<option selected value='cbxDCServerAlert'>-- Select DC Server --</option>" & vbCrLf
      Dim objRootDSE, strConfig, adoConnection, adoCommand, strQuery
      Dim adoRecordset, objDC, objSite
     
      Const adVarChar = 200
      Set SortRs = CreateObject("ADOR.Recordset")
      SortRs.fields.append "canonicalName",adVarChar,255
      SortRs.open
     
      ' Determine configuration context from RootDSE object.
      Set objRootDSE = GetObject("LDAP://RootDSE")
      strConfig = objRootDSE.Get("configurationNamingContext")
     
      ' Use ADO to search Active Directory for ObjectClass nTDSDSA.
      Set adoCommand = CreateObject("ADODB.Command")
      Set adoConnection = CreateObject("ADODB.Connection")
      adoConnection.Provider = "ADsDSOObject"
      adoConnection.Open "Active Directory Provider"
      adoCommand.ActiveConnection = adoConnection
     
      strQuery = "<LDAP://" & strConfig _
          & ">;(ObjectClass=nTDSDSA);AdsPath;subtree"
     
      adoCommand.CommandText = strQuery
      adoCommand.Properties("Page Size") = 100
      adoCommand.Properties("Timeout") = 30
      adoCommand.Properties("Cache Results") = False
     
      Set adoRecordset = adoCommand.Execute
     
      ' The parent object of each object with ObjectClass=nTDSDSA is a Domain
      ' Controller. The parent of each Domain Controller is a "Servers"
      ' container, and the parent of this container is the "Site" container.
      Do Until adoRecordset.EOF
          Set objDC = GetObject( _
        GetObject(adoRecordset.Fields("AdsPath").Value).Parent)
          Set objSite = GetObject(GetObject(objDC.Parent).Parent)
            'strHTML = strHTML & "<option value='" & objDC.cn & "'>" & objDC.cn & "</option>" & VbCrLf
            SortRs.AddNew
            SortRs.Fields("canonicalName") = objDC.cn
            SortRs.Update
          'Wscript.Echo "Domain Controller: " & objDC.cn & vbCrLf _
          '   & "DNS Host Name: " & objDC.DNSHostName & vbCrLf _
          '   & "Site: " & objSite.name
          adoRecordset.MoveNext
      Loop
      adoRecordset.Close

      With SortRs
            .Sort = "canonicalName asc"
            .MoveFirst
            While Not .EOF
                  strHTML = strHTML & "<option value='" & .Fields("canonicalName") & "'>" & .Fields("canonicalName") & "</option>" & VbCrLf
                  .MoveNext
            Wend
       End With
     
      strHTML = strHTML & "</select>"
      span_DCServer.InnerHTML = strHTML
     
      ' Clean up.
      adoConnection.Close
      Set objRootDSE = Nothing
      Set adoCommand = Nothing
      Set adoConnection = Nothing
      Set adoRecordset = Nothing
      Set objDC = Nothing
      Set objSite = Nothing
      Set SortRs = Nothing
End Sub


Sub Populate_Exchange_Servers()

      ' POPULATE THE EXCHANGE SERVER LIST BOX
     
      strHTML = "<select size='1' name='cbxExchServer' onChange='Populate_StorageGroups()'>" & vbCrLf
      Set cn = createobject("ADODB.Connection")
      Set cmd = createobject("ADODB.Command")
      Set rs = createobject("ADODB.Recordset")
      Set objRoot = getobject("LDAP://RootDSE")
      configurationNC = objRoot.Get("configurationnamingcontext")
      cn.open "Provider=ADsDSOObject;"
      cmd.activeconnection = cn
      cmd.commandtext = "<LDAP://" & configurationNC & _
                    ">;(objectCategory=msExchExchangeServer);name;subtree"
      Set rs = cmd.execute
      While rs.eof <> True And rs.bof <> True
            strHTML = strHTML & "<option value='" & rs(0) & "'>" & rs(0) & "</option>" & VbCrLf
            rs.movenext
      Wend
      cn.close
      strHTML = strHTML & "<option selected value='cbxExchServerAlert'>-- Select Exchange Server --</option>" & vbCrLf
      strHTML = strHTML & "</select>"
      span_ExchServer.InnerHTML = strHTML

End Sub

Sub Populate_StorageGroups()
'THIS PROCEDURE POPULATE THE cbxStorageGroup and cbxExch List Boxes
' for the Storage Group and the Mailstore
      strHTML = "<select size='1' name='cbxStorageGrp' onChange='Populate_MailStores()'>" & VbCrLf
      Dim objRootDSE,objConfiguration
      Dim cat,conn
      Dim cmd,RS
      Set objRootDSE = GetObject("LDAP://rootDSE")
      x=1
      strSrv=cbxExchServer.Value
      strConfiguration = "LDAP://" & objRootDSE.Get("configurationNamingContext")
      Set objConfiguration = GetObject(strConfiguration)
      strQuery="Select name,cn,distinguishedname from '" & _
      objConfiguration.ADSPath & "' Where objectclass='msExchStorageGroup'"      
      set cat=GetObject("GC:")
      for each obj in cat
       set GC=obj
      Next
      AdsPath=GC.ADSPath
      set conn=Createobject("ADODB.Connection")
      set cmd=CreateObject("ADODB.Command")
      conn.Provider="ADSDSOObject"
      conn.Open      
      set cmd.ActiveConnection=conn
      set RS=conn.Execute(strQuery)
      'WScript.Echo "Mailbox stores on " & UCase(strSrv) & ":"
      Do while not RS.EOF
             DN=rs.Fields("distinguishedname")
             'CN=RS.Fields("cn")
             NM=RS.Fields("name")
             If InStr(UCase(DN),UCase(strSrv)) Then
                  'WScript.Echo x & ") " &DN
                  'WScript.Echo "Name: " & NM
                  'WScript.Echo "CN: " & cn
                        strHTML = strHTML & "<option value='" & NM & "'>" & NM & "</option>" & VbCrLf
                  x=x+1
            End If
            rs.movenext
      Loop
      rs.Close
      conn.Close
      strHTML = strHTML & "<option selected value='cbxStorageGrpAlert'>-- Select Storage Group --</option>" & vbCrLf
      strHTML = strHTML & "</select>"
      span_StorageGroup.InnerHTML = strHTML

End Sub

Sub Populate_MailStores()
      strHTML = "<select size='1' name='cbxExch'>" & VbCrLf
     
      'Dim objRootDSE,objConfiguration
      'Dim cat,conn
      'Dim cmd,RS
      Set objRootDSE = GetObject("LDAP://rootDSE")
      x=1
      strSrv = cbxExchServer.Value
      strConfiguration = "LDAP://" & objRootDSE.Get("configurationNamingContext")
      Set objConfiguration = GetObject(strConfiguration)
      strQuery="Select name,cn,distinguishedname from '" & _
      objConfiguration.ADSPath & "' Where objectclass='msExchPrivateMDB'"      
      set cat=GetObject("GC:")
      for each obj In cat
       set GC=obj
      Next
      AdsPath=GC.ADSPath
      set conn=Createobject("ADODB.Connection")
      set cmd=CreateObject("ADODB.Command")
      conn.Provider="ADSDSOObject"
      conn.Open      
      set cmd.ActiveConnection=conn
      set RS=conn.Execute(strQuery)
      'WScript.Echo "Storage groups on " & UCase(strSrv) & ":"
      Do while not RS.EOF
            DN=rs.Fields("distinguishedname")
            CN=RS.Fields("cn")
            NM=RS.Fields("name")
            If InStr(UCase(DN),UCase(strSrv)) And InStr(UCase(DN),UCase(cbxStorageGrp.Value)) Then
                  strHTML = strHTML & "<option value='" & NM & "'>" & NM & "</option>" & VbCrLf
'                  WScript.Echo x & ") " &DN
'                  WScript.Echo "Name: " & NM
'                  WScript.Echo "CN: " & CN
                  x=x+1
            End If
            rs.movenext
      Loop
      rs.Close
      conn.Close      
      Set objRootDSE=Nothing
      Set objConfiguration=Nothing
      Set cat=Nothing
      Set conn=Nothing
      Set cmd=Nothing
      Set RS=Nothing
     
      strHTML = strHTML & "<option selected value='cbxExchAlert'>-- Select Server/Mailstore --</option>" & VbCrLf
      strHTML = strHTML & "</select>"
      span_cbxExch.InnerHTML = strHTML
End Sub

Sub chkExch_OnClick()
If chkExch.checked = True Then
cbxExch.Disabled = 0
Else
cbxExch.Disabled = 1
End If
End Sub
Sub chkDL_OnClick()
If chkDL.checked = True Then
cbxDL.Disabled = 1
Else
cbxDL.Disabled = 0
End If
End Sub



' ## Start user account creation process ##
Sub CreateAccount
      strUser = txtUser.Value
      If strUser = "" Then
            MsgBox "You are missing required fields.",64, "Alert"
            Exit Sub
      End If
      strFirst = txtFirst.Value
      If strFirst = "" Then
            MsgBox "You are missing required fields.",64, "Alert"
            Exit Sub
      End If
      strInitial = txtMiddle.Value
      strLast = txtLast.Value
      If strLast = "" Then
            MsgBox "You are missing required fields.",64, "Alert"
            Exit Sub
      End If
      strDisplay = UCase(Left(strLast, 1)) & LCase(Right(strLast, Len(strLast) - 1)) & " " _
            & UCase(Left(strFirst, 1)) & LCase(Right(strFirst, Len(strFirst) - 1))
      strTitle = txtTitle.Value
      strOffice = cbxSite.Value
      strDepartment = txtDepartment.Value
      strCompany = txtCompany.Value
      strManager = txtManager.Value
      strCN = UCase(Left(strLast, 1)) & LCase(Right(strLast, Len(strLast) - 1)) & " " _
            & UCase(Left(strFirst, 1)) & LCase(Right(strFirst, Len(strFirst) - 1))
      Set objConnection = CreateObject("ADODB.Connection")
      objConnection.Open "Provider=ADsDSOObject;"
      Set objCommand = CreateObject("ADODB.Command")
      objCommand.ActiveConnection = objConnection
      objCommand.CommandText = _
      "<GC://" & defaultNC & ">;(&(objectCategory=Person)(objectClass=user)" & _
      "(samAccountName=" & strUser & "));samAccountName;subtree"
      Set objRecordSet = objCommand.Execute
      If objRecordSet.RecordCount = 0 Then
      Else
      MsgBox "The User Account already exists.",48,"Alert"
      Exit Sub
      End If
      objConnection.Close
     
      Const FORWRITING= 2
      Const ADS_UF_ACCOUNTDISABLE = 2
      Const ADS_PROPERTY_UPDATE = 2
      Const ADS_PROPERTY_APPEND = 3
     
      ' ## Determine if Creation of User Mailbox required ##
      If chkExch.checked = "True" And cbxExch.value = "cbxExchAlert" Then
      MsgBox "You must select either a Server/Mailstore or " & vbcrlf _
      & "de-select the 'Create Mailbox' checkbox." ,64, "Alert"
      Exit Sub
      End If
      ' ## Add user to required Distribution List ##
      If chkDL.checked ="True" And cbxDL.value = "cbxDLAlert" Then
      MsgBox "You must select a Distribution List or " & vbcrlf _
      & "de-select the 'Distribution List' checkbox." ,64, "Alert"
      Exit Sub
      End If
      ' ## Ensure users site/office selected ##
      If cbxSite.Value = "cbxOfficeAlert" Then
      MsgBox "You must select the users office.",64, "Alert"
      Exit Sub
      End If
      Select Case cbxSite.Value
      Case "Birmingham"
      strOffice = "Birmingham"
      strLDAPdn = "OU=_ Birmingham," & BaseOU
      strUserServer = "Northsea"
      Case "Exeter"
      strOffice = "Exeter"
      strLDAPdn = "OU=_ Exeter," & BaseOU
      strUserServer = "Cluster"
      Case "Hatfield"
      strOffice = "Hatfield"
      strLDAPdn = "OU=_ Hatfield," & BaseOU
      strUserServer = "Data1Hat"
      Case "Leeds"
      strOffice = "Leeds"
      strLDAPdn = "OU=_ Leeds," & BaseOU
      strUserServer = "Sagat"
      Case "Newcastle"
      strOffice = "Newcastle"
      strLDAPdn = "OU=_ Newcastle," & BaseOU
      strUserServer = "fluorine" <!-- Arsenic -->
      Case "Other"
      strOffice = "Other"
      strLDAPdn = "OU=_ Other," & BaseOU
      strUserServer = "fluorine"
      Case "Other"
      strOffice = "Other"
      strLDAPdn = "OU=_ Oxford," & BaseOU
      strUserServer = "Data1Oxf"
      Case "Paddington"
      strOffice = "Paddington"
      strLDAPdn = "OU=_ Paddington," & BaseOU
      strUserServer = "Data1Pad"
      Case "Portland House"
      strOffice = "Portland"
      strLDAPdn = "OU=_ Portland House," & BaseOU
      strUserServer = "Data1Pot"
      Case "Redditch"
      strOffice = "Redditch"
      strLDAPdn = "OU=_ Redditch," & BaseOU
      strUserServer = "Red-DC"
      Case "Richmond House"
      strOffice = "Richmond House"
      strLDAPdn = "OU=_ Richmond House," & BaseOU
      strUserServer = "Data1Rich"
      Case "Slough"
      strOffice = "Slough"
      strLDAPdn = "OU=_ Slough," & BaseOU
      strUserServer = "Data1Slo"
      Case "Tavistock"
      strOffice = "Tavistock House"
      strLDAPdn = "OU=_ Tavistock House," & BaseOU
      strUserServer = "fluorine" <!-- maverick -->
      Case "Winchester"
      strOffice = "Winchester"
      strLDAPdn = "OU=_ Winchester," & BaseOU
      strUserServer = "fluorine"
      End Select
     
      Set objOU = GetObject("LDAP://" & strLDAPdn)
      Set objUser = objOU.Create("User", "cn=" & strCN)
     
      objUser.Put "sAMAccountName", LCase(strUser)
      objUser.SetInfo
      objUser.Put "givenName", UCase(Left(strFirst, 1)) & LCase(Right(strFirst, Len(strFirst) - 1))
      If strInitial <> "" Then
      objUser.Put "initials", UCase(Left(strInitial, 1)) & LCase(Right(strInitial, Len(strInitial) - 1))
      End If
      objUser.Put "sn", UCase(Left(strLast, 1)) & LCase(Right(strLast, Len(strLast) - 1))
      objUser.Put "displayName", UCase(Left(strLast, 1)) & LCase(Right(strLast, Len(strLast) - 1)) & " " _
      & UCase(Left(strFirst, 1)) & LCase(Right(strFirst, Len(strFirst) - 1))
     
      If strTitle <> "" Then
      objUser.put "title", strTitle
      End If
      If strDepartment <> "" Then
      objUser.put "department", strDepartment
      End If
      If strCompany <> "" Then
      objUser.put "company", strCompany
      End If
      If strManager <> "" Then
      objUser.put "manager", strManager
      End If
      objUser.put "physicalDeliveryOfficeName", strOffice
      objUser.put "description", strTitle
      objUser.Put "userPrincipalName", LCase(strUser) & "@" & defaultNC
     
      objUser.SetPassword "welcome"
      objUser.Put "pwdLastSet", 0
     
      intUAC = objUser.Get("userAccountControl")
      If intUAC And ADS_UF_ACCOUNTDISABLE Then
      objUser.Put"userAccountControl", intUAC Xor ADS_UF_ACCOUNTDISABLE
      End If
      objUser.SetInfo
      ' ## Add Users to selected groups ##
      If chkGrpOne.Checked Then
      Set objGroup = GetObject _
      ("LDAP://cn=NPFIT,OU=Other Mail-enabled Security Groups,OU=Groups,OU=__ Migration Staging," & BaseOU)
      objGroup.PutEx ADS_PROPERTY_APPEND, _
      "member", Array("cn=" & strCN & "," & strLDAPdn)
      objGroup.SetInfo
      End If
     
      If chkGrpTwo.Checked Then
      Set objGroup = GetObject _
      ("LDAP://cn=Share - NPSO Files,OU=File Share Access,OU=Groups,OU=__ Migration Staging," & BaseOU)
      objGroup.PutEx ADS_PROPERTY_APPEND, _
      "member", Array("cn=" & strCN & "," & strLDAPdn)
      objGroup.SetInfo
      End If
     
      If chkGrpThree.Checked Then
      Set objGroup = GetObject _
      ("LDAP://cn=Shared Data,OU=Universal Security,OU=Groups (Don't Migrate?),OU=_ Migration Staging - DO NOT MOVE OR ADD OBJECTS HERE!," & defaultNC)
      objGroup.PutEx ADS_PROPERTY_APPEND, _
      "member", Array("cn=" & strCN & "," & strLDAPdn)
      objGroup.SetInfo
      End If
      ' ## Create User Mailbox Process ##
     
      If ChkExch.Checked Then
      Call CreateMailbox (strCN,strLDAPdn)
      End If
      ' ## Create User Folder Process ##
      If chkUserFolder.Checked Then
      Call CreateUserFolder (strUser,strUserServer)
      End If
      ' ## Writes entry into logfile ##
      If chkLogging.Checked Then
      WriteLog("Account Created: " & DateToStr() & ", " & Time() & ", " & strUser _
      & ", " & strFirst & " " & strLast & ", " & strOffice)
      End If
      ' ## Reloads Page on completion of User Creation ##
      Location.Reload(True)
      MsgBox "User Successfully Created.",64, "Alert - User Creation Successful."
End Sub



Sub CreateMailbox (strCN,strLDAPdn)
      ' ## Start Mail Account Creation Process ##
     
      Dim oIADSUser
      Dim strMStore
      Set oIADSUser = GetObject("LDAP://cn=" & strCN & "," & strLDAPdn)
      ' ## EXCHPE MAIL STORES ##
      Select Case cbxExch.Value
      Case "EXCHPEA2G"
      strExchServer = "EXCHPE"
      strMStore = "A2G"
      strStoreGP = "2nd Storage Group"
      Case "EXCHPEH2M"
      strExchServer = "EXCHPE"
      strMStore = "H2M"
      strStoreGP = "2nd Storage Group"
      Case "EXCHPEN2S"
      strExchServer = "EXCHPE"
      strMStore = "N2S"
      strStoreGP = "3rd Storage Group"
      Case "EXCHPET2Z"
      strExchServer = "EXCHPE"
      strMStore = "T2Z"
      strStoreGP = "3rd Storage Group"
      ' ## EXCHAQ2 MAIL STORES ##
      Case "EXCHAQ2A2G"
      strExchServer = "EXCHAQ2"
      strMStore = "A2G"
      strStoreGP = "2nd Storage Group"
      Case "EXCHAQ2H2M"
      strExchServer = "EXCHAQ2"
      strMStore = "H2M"
      strStoreGP = "2nd Storage Group"
      Case "EXCHAQ2N2S"
      strExchServer = "EXCHAQ2"
      strMStore = "N2S"
      strStoreGP = "3rd Storage Group"
      Case "EXCHAQ2T2Z"
      strExchServer = "EXCHAQ2"
      strMStore = "T2Z"
      strStoreGP = "3rd Storage Group"
      Case "ODIN"
      strExchServer = "ODIN"
      strMStore = "Mailbox Store (ODIN)"
      strStoreGP = "First Storage Group"
      End Select
     
      oIADSUser.CreateMailbox ("LDAP://CN=" & strMStore & ",CN=" & strStoreGP & ",CN=InformationStore,CN=" & strExchServer & ",CN=Servers,CN=NHSIA,CN=Administrative Groups,CN=NHS,CN=Microsoft Exchange,CN=Services,CN=Configuration,DC=nhsia,DC=nhs,DC=uk")
      oIADSUser.SetInfo
      ' ## End of Mail Account Creation Process ##
End Sub




Sub CreateUserFolder (strUser,strUserServer)

' ## If Users Home Server is flourine then Users home drive has to be created manually ##
If strUserServer = "fluorine" Then
MsgBox "User folder must be created manually.",16, "Alert - Folder Creation Unsuccessful."
Exit Sub
End If
' ## Create the Users home folder on respective server ##
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder("\\" & strUserServer & "\users")
' ## Create users home folder ##
If objFSO.FolderExists("\\" & strUserServer & "\users\" & strUser) = False Then
objFSO.CreateFolder("\\" & strUserServer & "\users\" & LCase(strUser))
End If

' ## Assign user change NTFS permissions on home drives ##
Set objShell = CreateObject("Wscript.Shell")
strUserFolder = "\\" & strUserServer & "\users\" & strUser
objShell.Run ("SetACL.exe -on """ & strUserFolder & """ -ot file -actn ace " & "-ace ""n:npfit.nhs.uk\" & strUser & ";p:change""")
End Sub
Sub WriteLog (strMessage)
Dim LogFile
Dim fs
Dim fsOut
Logfile = Logpath & "AccountCreation.log"
Set fs = CreateObject("Scripting.FileSystemObject")
Set fsOut = fs.OpenTextFile(LogFile, ForAppending, True)
fsOut.WriteLine (strMessage)
fsOut.Close
End Sub
Function DateToStr()
DateToStr = DatePart("d",Now) & "/" & DatePart("m",Now) & "/" & DatePart("yyyy",Now)
End Function

' ## Reloads Page on pressing [Clear Form] ##
Sub Reload
Location.Reload(True)
End Sub

' ## Closes page on pressing [Exit] ##
Sub CloseForm
Window.Close
End Sub 'CloseForm

Sub About()
On Error Resume Next
strAbout="Eroom User Account Creation Form v1.0" & VbCrLf
strAbout= strAbout & "____________________________" & vbTab & VbCrLf & VbCrLf
strAbout=strAbout & " Company name" & VbCrLf & VbCrLf
strAbout=strAbout & " Author: Chandru" & VbCrLf
strAbout=strAbout & " Date: 13 May 2007" & vbcrlf & vbcrlf
strAbout= strAbout & "____________________________" & VbCrLf & VbCrLf
MsgBox strAbout,vbOKOnly+vbInformation,"About"
End Sub

Sub CreateAccount2()
      If txtFirst.Value = "" Then
            MsgBox "Please enter a first name.",64, "Alert"
            Exit Sub
      End If
      If txtLast.Value = "" Then
            MsgBox "Please enter a last name.",64, "Alert"
            Exit Sub
      End If
      If cbxDCServer.Value = "cbxDCServerAlert" Then
            MsgBox "You must select a DC Server.",64, "Alert"
            Exit Sub
      End If
      If cbxExchServer.Value = "cbxExchServerAlert" Then
            MsgBox "You must select an Exchange Server.",64, "Alert"
            Exit Sub
      End If
      If cbxStorageGrp.Value = "cbxStorageGrpAlert" Then
            MsgBox "You must select a StorageGroup.",64, "Alert"
            Exit Sub
      End If
      If cbxExch.Value = "cbxExchAlert" Then
            MsgBox "You must select an Exchange Server.",64, "Alert"
            Exit Sub
      End If
      If cbxMbxLanguage.Value = "cbxMbxLanguageAlert" Then
            MsgBox "You must select a Mailbox Language.",64, "Alert"
            Exit Sub
      End If
      strDCServerName = cbxDCServer.Value
      strServerName = cbxExchServer.Value
      strStorageGroup = cbxStorageGrp.Value
      strMailboxStore = cbxExch.Value
      strGivenName = txtFirst.Value
      strSurname = txtLast.Value
      strFolderLang = cbxMbxLanguage.Value
      'Call AutomateMailboxCreation(strDCServerName, strServerName, strStorageGroup, strMailboxStore, strGivenName, strSurname, strFolderLang)
      MsgBox "AutomateMailboxCreation(" & strDCServerName & ", " & strServerName & ", " & strStorageGroup & ", " & strMailboxStore & ", " & strGivenName & ", " & strSurname & ", " & strFolderLang & ")"
End Sub

</script>
</head>

<body>
<!-- Start Of Main Table -->
<table width="710" border="0" cellspacing="0" CellSpacing="0">
<tr><td width="350" Valign="top" align="center">
<!-- LHS Of Main Table -->
<table border="0" cellspacing="0" CellSpacing="0">
<span id="span_Logo"></span>
<tr><td width="350">
<!-- Username/Logon name -->
<table border="0" cellspacing="0" CellSpacing="0" width="350">
<tr><td valign="top" colspan="3"><fieldset><legend><b>Username/Logon name</b></legend>
<table border="0" cellpadding="3" width="350">
<tr><td width="110">Logon name:</td><td><input type="text"
name="txtUser" style="width:195px"></td><td>&nbsp;</td></tr>
<tr><td>First Name: </td><td><input type="text" name="txtFirst" style="width:195px"></td><td
width="50">&nbsp;</td></tr>
<tr><td>Last Name: </td><td><input type="text" name="txtLast" style="width:195px"></td><td>&nbsp;</td></tr>
</table><p></fieldset></table>
<!-- End of Username/Logon name -->
<!-- User Account Properties -->
<table border="0" cellpadding="0" cellspacing="0" width="350">
<tr><td valign="top" colspan="3"><fieldset><legend><b>User Account Properties</b></legend>
<table border="0" cellpadding="3" width="350">
<tr>
<td width="110">Job Title:</td><td><input type="text" name="txtTitle" style="width:195px"></td><td>&nbsp;</td>
</tr>
<tr><td>Office: </td>
<td align="right">
      <SPAN id="span_Office"></SPAN>
</td>
<td>&nbsp;</td>
</tr>
<tr>
<td>Department: </td><td><input type="text" name="txtDepartment" style="width:195px"></td><td width="50">&nbsp;</td>
</tr>
<tr>
<td>Company: </td><td><input type="text" name="txtCompany" value="Company name" style="width:195px"></td><td>&nbsp;</td>
</tr>
<tr>
<td>Manager: </td><td><input type="text" name="txtManager" style="width:195px"></td>
</tr>
<td>Manager: </td><td><input type="text" name="txtManager" style="width:195px"></td>
</tr>
</table><p></fieldset></table>
<!-- End of User Account Properties -->
<!-- Group Membership -->
<table border="0" cellspacing="0" CellSpacing="0" width="350">
<tr>
<td valign="top" colspan="3"><fieldset><legend><b>Group Membership</b></legend>
<table border="0" cellpadding="3" width="350">
<tr>
<td width="150"><b>Group Name</b></td><td width="200" align="middle">Select to add user to group(s)</td>
</tr>
<tr>
<td width="150">NPFIT (File Access)</td><td width="200" align="middle"><input type="checkbox" name="chkGrpOne"></td>
</tr>
<tr>
<td width="150">Share - NPSO Files</td><td width="200" align="middle"><input type="checkbox" name="chkGrpTwo"></td>
</tr>
<tr>
<td width="150">Shared Data &nbsp;&nbsp;<font size="3" color="red"><b>*</b></font></td><td width="200" align="middle"><input type="checkbox" name="chkGrpThree" disabled="False"></td>
</tr>
</table><p></fieldset></table>
<!-- End of Group Membership -->
<!-- End of LHS Of Main Table -->
</td></tr></table>

</td>

<td width="350" Valign="top">
<!-- RHS Of Main Table -->
<span id="span_User"></span>
<table border="0" cellspacing="0" CellSpacing="0">
<tr><td width="350">
<!-- Create User Mail Account -->
<table border="0" cellspacing="0" CellSpacing="0" width="350">
<tr><td valign="top" colspan="3"><fieldset><legend><b>User Mail Account</b></legend>
<table border="0" cellpadding="3" width="350">
<tr>
<td width="300">Create user mailbox?</td><td width="50" align="middle"><input type="checkbox" name="chkExch"checked="False"disabled="False"></td>
</tr></table>
<table border="0" cellpadding="3" width="350">
<tr>
<td width="125">
      DC Server:
</td>
<td align="right">
      <SPAN ID='span_DCServer'></SPAN>
</td>
</tr>
<tr>
<td width="125">
      Exchange Server:
</td>
<td align="right">
      <SPAN ID='span_ExchServer'></SPAN>
</td>
</tr>
<tr>
<td width="125">
      Storage Group:
</td>
<td align="right">
      <SPAN ID='span_StorageGroup'></SPAN>
</td>
</tr>
<tr>
<td width="125">
      Server/Mailstore:
</td>
<td align="right">
      <SPAN ID='span_cbxExch'></SPAN>
</td>
</tr>
<tr>
<td width="125">
      Mailbox Language:
</td>
<td align="right">
<select size="1" name="cbxMbxLanguage">
<option value="en-us">Engish (US)</option>
<option value="kor">Korean</option>
<option selected value="cbxMbxLanguageAlert">-- Select Mailbox Language --</option>
</select>
</td>
</tr>
</table><p></fieldset></table>
<!-- End of Create User Mailbox -->
<!-- Add to Distribution Lists -->
<table border="0" cellspacing="0" CellSpacing="0" width="350">
<tr><td valign="top" colspan="3"><fieldset><legend><b>Distribution Lists</b></legend>
<table border="0" cellpadding="3" width="350">
<tr>
<td width="300">Add user to Distribution List?</td><td width="50" align="middle"><input type="checkbox" name="chkDL" disabled="false"></td>
</tr></table>
<table border="0" cellpadding="3" width="350">
<tr><td width="125">Distribution List: &nbsp;&nbsp;<font size="3" color="red"><b>*</b></font></td>
<td align="right"><select size="1" name="cbxDL" disabled="true">
<option value="DLBirmingham">Aqueous II</option>
<option value="DLExeter">DL Exeter</option>
<option value="DLOxford">DL Oxford</option>
<option value="DLPortland ">DL Portland</option>
<option value="DLHatfield">DL Hatfield</option>
<option value="DLHuntingdon">DL Huntingdon</option>
<option value="DLNewcastle">DL Newcastle</option>
<option value="DLPaddington">DL Paddington</option>
<option value="DLSlough">DL Slough</option>
<option value="DLTavistock">DL Tavistock House</option>
<option selected value="cbxDLAlert">-- Select Distribution List --</option>
</select></td>
</tr>
</table><p></fieldset></table>
<!-- End of Add to Distribution Lists -->
<!-- Create User Home Directory -->
<table border="0" cellspacing="0" CellSpacing="0" width="350">
<tr><td valign="top" colspan="3"><fieldset><legend><b>User Home Directory</b></legend>
<table border="0" cellpadding="3" width="350">
<tr>
<td width="300">Create User Home Directory?</td><td width="50" align="middle">
<input type="checkbox" name="chkUserFolder" checked="false">
</td></tr>
</table><p></fieldset></table>
<!-- End Of Create User Home Directory -->
<!-- Enable Logging -->
<table border="0" cellspacing="0" CellSpacing="0" width="350">
<tr><td valign="top" colspan="3"><fieldset><legend><b>Enable Logging</b></legend>
<table border="0" cellpadding="3" width="350">
<tr>
<td width="300">Enable Logging?</td><td width="50" align="middle">
<input type="checkbox" name="chkLogging" checked="false">
</td></tr>
</table><p></fieldset></table>
<!-- End Of Enable Logging -->
<table border="0" cellspacing="0" cellpadding="0" width="350">
<tr>
<td valign="top">
<!-- Blank Table for future additions/features -->
&nbsp;<b>NOTE:</b> Items marked with <font size="3" color="red"><b>*</b></font> are disabled until the next version is complete.
</td></tr>
&nbsp;<b>NOTE:</b> <font size="1" color="White"><b><blink>The new user account object will have an default password - Pa$$word12</blink></b></font>
</td></tr>
</table>
<!-- End of RHS Of Main Table -->
</td></tr></table>
</td></tr></table>
<!-- End Of Main Table -->
<table align="center" border="0" cellspacing="0" cellpadding="0" width="350">
<tr>
<td align="right" valign="bottom">
<input type="button" value=" About " onclick="About">
<input type="button" value="Clear Form" onclick="Reload" title=" Click to Clear Form "> 
<input type="button" value=" Submit " onClick="CreateAccount2" title=" Click to Create User Account "> 
<input type="button" value=" Exit " onclick="CloseForm" title=" Click to Exit Form ">
</td></tr>
</table>
</body>
</html>


regards
Chandru
Thanks Chandru,
Rob
For the HTA to suit my network what are the changes i need to do.?


I get this.
---------------------------
Error
---------------------------
A Runtime Error has occurred.
Do you wish to Debug?

Line: 680
Error: Object required: 'cbxDCServer'
---------------------------
Yes   No  
---------------------------
Rob & Chandru,

For the Hta code you gave me i have changed the OU path and the Domain admin name so now i am able to see all my Dc's and exchanges.

I get this now.

---------------------------

---------------------------
AutomateMailboxCreation(INDC01, INEXCHANGE1, First Storage Group, Mailbox Store (INEXCHANGE1), Sharma, Kumar, en-us)
---------------------------
OK  
---------------------------
Rob did you have time to look into it....
Hi Sharath,

Can you give this script a try? Hope this suits your needs


http://www.msexchange.org/articles/Creating-Exchange-Users-Excel.html

regards
Chandru

Did you manage to try this script?
Chandru i would require help in tuning it up to my Domain..

Have you tried it...If yes can you help me...
I use this script as per the website...

Sub CreateUsers()

Dim Row As Integer
Dim oMailbox As CDOEXM.IMailboxStore
Dim oUser As IADsUser

Set rootDSE = GetObject(LDAP://RootDSE)
DomainContainer = rootDSE.Get("defaultNamingContext")
Set oOU = GetObject(LDAP://OU=Named Accounts,OU=User Accounts,OU=IND,OU=Countries,DC=Development,DC=Group,DC=co,DC=uk)

Row = 1

Do Until Cells(Row, 1) = Empty
    gname = Trim(Cells(Row, 1).Value)
    sname = Trim(Cells(Row, 2).Value)
    ID = Cells(Row, 3).Value
    mailingaddress = Cells(Row, 4).Value
    city = Cells(Row, 5).Value
    postalcode = Cells(Row, 6).Value
    homephone = Cells(Row, 7).Value
    cellular = Cells(Row, 8).Value
    dept = Trim(Cells(Row, 9).Value)

            FullName = gname & " " & sname

    AliasCount = 2
    Alias = LCase(gname & Left(sname, AliasCount))

    Set conn = CreateObject("ADODB.Connection")
    conn.Provider = "ADSDSOObject"
    conn.Open "ADs Provider"

    ldapStr = "<LDAP://" & DomainContainer & ">;(&(objectCategory=user)(mailNickname=" & Alias & "));adspath;subtree"

    Set rs = conn.Execute(ldapStr)

    While rs.RecordCount > 0
      AliasCount = AliasCount + 1
      Alias = LCase(gname & Left(sname, AliasCount))
      ldapStr = "<LDAP://" & DomainContainer & ">;(&(objectCategory=user)(mailNickname=" & Alias & "));adspath;subtree"
      Set rs = conn.Execute(ldapStr)

    Wend
    ' Update User Record
    Set oUser = oOU.Create("user", "cn=" & FullName)
    oUser.Put "cn", FullName
    oUser.Put "SamAccountName", Alias
    oUser.Put "userPrincipalName", Alias & "@mycompany.local"
    oUser.Put "givenName", gname
    oUser.Put "sn", sname
    oUser.Put "description", ID
    oUser.SetInfo
    oUser.GetInfo

    ' Enable Account
    oUser.AccountDisabled = False
    ' Set Pwd to be same as 123456
    oUser.SetPassword ("123456")
    'Account is not disabled
    oUser.AccountDisabled = False
    ' User must change password at next Logon
    oUser.Put "pwdLastSet", CLng(0)

    oUser.SetInfo

    Set oMailbox = oUser
    MDBName = "Mailbox Store (EXCHANGE)"
    StorageGroup = "First Storage Group"
    Server = "Exchange"
    AdminGroup = "MyCompany"
    Organization = "MyCompany School of Arts"
    DomainDN = "DC=mycompany,DC=local"

    oMailbox.CreateMailbox "LDAP://CN=" & MDBName & _
                                   ",CN=" & StorageGroup & _
                                   ",CN=InformationStore" & _
                                   ",CN=" & Server & _
                                   ",CN=Servers" & _
                                   ",CN=" & AdminGroup & _
                                   ",CN=Administrative Groups" & _
                                   ",CN=" & Organization & _
                                   ",CN=Microsoft Exchange,CN=Services" & _
                                   ",CN=Configuration," & DomainDN

    oUser.SetInfo

    StrobjGroup1 = "LDAP://CN=" & dept & ",OU=Named Accounts,OU=User Accounts,OU=IND,OU=Countries,DC=Development,DC=Group,DC=co,DC=uk"
    Set objGroup1 = GetObject(StrobjGroup1)
    objGroup1.Add (oUser.ADsPath)

    Set oUser = Nothing
    Row = Row + 1
Loop

End Sub



I get this error.

---------------------------
Windows Script Host
---------------------------
Script:      C:\Website usercreation.vbs
Line:      3
Char:      9
Error:      Expected end of statement
Code:      800A0401
Source:       Microsoft VBScript compilation error

---------------------------
OK  
---------------------------
Hi,

I will have a look and will get back to you

regards
Chandru
Ok Chandru...
Rob has already given me a way to create a user with all details from a excel...Just the Mailbox portion is pending...
Can you post the code for the same? So i can work on the same
Here is the Code...

'====================
' Bind to Active Directory.
Set objRootLDAP = GetObject("LDAP://rootDSE")

' CONFIGURATION PARAMETERS FOR THE SCRIPT
strExcelFile = Replace(WScript.ScriptFullName, WScript.ScriptName, "") & "Users_Sharath.xls"
strOUPath = "OU=Named Accounts,OU=User Accounts,OU=IND,OU=Countries," & objRootLDAP.Get("defaultNamingContext")
strPassword = "abc123"
' END CONFIGURATION PARAMETERS

Const xlUp = -4162
Const ADS_UF_DONT_EXPIRE_PASSWD = &H10000
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.Workbooks.Open strExcelFile

Set objNetwork = CreateObject("WScript.Network")
strDomainName = objNetwork.UserDomain

For intRow = 2 To objExcel.ActiveSheet.Cells(65536, "A").End(xlUp).Row

      strFullName = Trim(objExcel.ActiveSheet.Cells(intRow, "A").Value)
      strUserName = Trim(objExcel.ActiveSheet.Cells(intRow, "B").Value)
      strEmail = Trim(objExcel.ActiveSheet.Cells(intRow, "C").Value)
      strManager = Trim(objExcel.ActiveSheet.Cells(intRow, "D").Value)
      strGroups = Trim(objExcel.ActiveSheet.Cells(intRow, "E").Value)
      strTitle = Trim(objExcel.ActiveSheet.Cells(intRow, "F").Value)
      strCompany = Trim(objExcel.ActiveSheet.Cells(intRow, "G").Value)
      strDepartment = Trim(objExcel.ActiveSheet.Cells(intRow, "H").Value)
      strDescription = Trim(objExcel.ActiveSheet.Cells(intRow, "I").Value)
      strOfficePh = Trim(objExcel.ActiveSheet.Cells(intRow, "J").Value)
      strMobilePh = Trim(objExcel.ActiveSheet.Cells(intRow, "K").Value)
      strHomePh = Trim(objExcel.ActiveSheet.Cells(intRow, "L").Value)
     
      strFirstName = Trim(Left(strFullName, InStrRev(strFullName, " ") - 1))
      strLastName = Trim(Mid(strFullName, InStrRev(strFullName, " ") + 1))
           
      If strFullName <> "" And strUserName <> "" And strEmail <> "" Then
           
            MsgBox "About to create:" & VbCrLf &_
                  strFullName & VbCrLf &_
                  strFirstName & VbCrLf &_
                  strLastName & VbCrLf & _
                  strUserName & VbCrLf &_
                  strPassword & VbCrLf &_
                  strManager & VbCrLf &_
                  "LDAP://" & strOUPath
                 
            ' This will add the user to eg. Domain.Local\Users
            Set objContainer = GetObject("LDAP://" & strOUPath)
           
            ' Check if the user already exists
            On Error Resume Next
           
            Set objNewUser = GetObject("LDAP://cn=" & strFullName & "," & strOUPath)
            If Err.Number = 0 Then
                  MsgBox "User " & strFullName & " already exists."
                  On Error GoTo 0
            Else
                  Err.Clear
                  On Error GoTo 0
           
                  ' Build the actual User.
                  ' Attributes listed here: http://support.microsoft.com/kb/555638
                  Set objNewUser = objContainer.Create("User", "cn= " & strFullName)
                  'objNewUser.Put "userPrincipalName", strUserName & "@" & Replace(Replace(objRootLDAP.Get("defaultNamingContext"), ",", "."), "DC=", "")
                  If InStr(strUserName, "@") > 0 Then
                        arrDomUserName = Split(strUserName, "@")
                        strUserName = arrDomUserName(0)
                        strSuffix = arrDomUserName(1)
                  Else
                        strUserName = strUserName
                        strSuffix = Replace(Replace(objRootLDAP.Get("defaultNamingContext"), ",", "."), "DC=", "")
                  End If
                  objNewUser.Put "userPrincipalName", strUserName & "@" & strSuffix
                  objNewUser.Put "sAMAccountName", strUserName
                  objNewUser.Put "givenName", strFirstName
                  objNewUser.Put "sn", strLastName
                  objNewUser.Put "displayName", strFullName
                  objNewUser.Put "mail", strEmail
                  If strManager <> "" Then
                        Set objManager = GetObject(Get_LDAP_User_Properties("user", "samAccountName", strManager, "adsPath"))
                        objNewUser.Put "manager", Replace(objManager.AdsPath, "LDAP://", "")
                        Set objManager = Nothing
                  End If
                  If strTitle <> "" Then objNewUser.Put "Title", strTitle
                  If strCompany <> "" Then objNewUser.Put "company", strCompany
                  If strDepartment <> "" Then objNewUser.Put "department", strDepartment
                  If strDescription <> "" Then objNewUser.Put "description", strDescription
                  If strOfficePh <> "" Then objNewUser.Put "telephoneNumber", strOfficePh
                  If strHomePh <> "" Then objNewUser.Put "homePhone", strHomePh
                  If strMobilePh <> "" Then objNewUser.Put "mobile", strMobilePh
                  objNewUser.SetInfo
                  objNewUser.SetPassword strPassword
                  objNewUser.AccountDisabled = False
                  objNewUser.SetInfo

                  intUserAccountControl = objNewUser.Get("userAccountControl")
                  If Not objNewUser.userAccountControl AND ADS_UF_DONT_EXPIRE_PASSWD Then
                      objNewUser.Put "userAccountControl", objNewUser.userAccountControl XOR ADS_UF_DONT_EXPIRE_PASSWD
                        objNewUser.SetInfo
                  End If
               
                  If strGroups <> "" Then
                        arrGroups = Split(strGroups, ":")
                        For Each strGroupName In arrGroups
                              strGroupPath = Get_LDAP_User_Properties("group", "cn", strGroupName, "adsPath")
                              If strGroupPath <> "" Then
                                    Set objGroup = GetObject(strGroupPath)
                                    On Error Resume Next
                                    objGroup.Add objNewUser.AdsPath
                                    If Err.Number <> 0 Then
                                          Err.Clear
                                          On Error GoTo 0
                                          boolUserAdded = False
                                          arrSid = objNewUser.objectSid
                                          strSidHex = OctetToHexStr(arrSid)
                                          strSidDec = HexSIDtoSDDL(strSidHex)
                                          On Error Resume Next
                                          objGroup.Add "LDAP://<SID=" & strSidDec & ">"
                                          If Err.Number <> 0 Then
                                                boolUserAdded = False
                                                'WScript.Echo Err.Number & ": " & Err.Description & " - cannot add " & Replace(objDomUser.AdsPath, "WinNT://", "") & " to " & objGroup.adspath
                                                WScript.Echo Err.Number & ": " & Err.Description & " - cannot add " & strSidDec & " to " & objGroup.adspath
                                                Err.Clear
                                                On Error GoTo 0
                                          Else
                                                boolUserAdded = True
                                          End If
                                    Else
                                          boolUserAdded = True
                                    End If
                                    If boolUserAdded = True Then
                                          WScript.Echo "User " & strUserName & " was added to the group " & objGroup.AdsPath
                                    Else
                                          WScript.Echo "Could not add user " & strUserName & " to the group " & strGroupName
                                    End If
                                    Set objGroup = Nothing
                              Else
                                    WScript.Echo "Could not locate the group " & strGroupName & " to add the user " & objNewUser.samAccountName & " to."
                              End If
                        Next
                  End If
            End If
      End If
Next

MsgBox "Done"
objExcel.ActiveWorkbook.Close False
objExcel.Quit
Set objExcel = Nothing

Function Get_LDAP_User_Properties(strObjectType, strSearchField, strObjectToGet, strCommaDelimProps)
     
      If InStr(strObjectToGet, "\") > 0 Then
            arrGroupBits = Split(strObjectToGet, "\")
            strDC = arrGroupBits(0)
            strDNSDomain = strDC & "/" & "DC=" & Replace(Mid(strDC, InStr(strDC, ".") + 1), ".", ",DC=")
            strObjectToGet = arrGroupBits(1)
      Else
            Set objRootDSE = GetObject("LDAP://RootDSE")
            strDNSDomain = objRootDSE.Get("defaultNamingContext")
      End If

      strBase = "<LDAP://" & strDNSDomain & ">"
      ' Setup ADO objects.
      Set adoCommand = CreateObject("ADODB.Command")
      Set adoConnection = CreateObject("ADODB.Connection")
      adoConnection.Provider = "ADsDSOObject"
      adoConnection.Open "Active Directory Provider"
      adoCommand.ActiveConnection = adoConnection

 
      ' Filter on user objects.
      'strFilter = "(&(objectCategory=person)(objectClass=user))"
      strFilter = "(&(objectClass=" & strObjectType & ")(" & strSearchField & "=" & strObjectToGet & "))"

      ' Comma delimited list of attribute values to retrieve.
      strAttributes = strCommaDelimProps
      arrProperties = Split(strCommaDelimProps, ",")

      ' Construct the LDAP syntax query.
      strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
      adoCommand.CommandText = strQuery
      adoCommand.Properties("Page Size") = 100
      adoCommand.Properties("Timeout") = 30
      adoCommand.Properties("Cache Results") = False

      ' Run the query.
      Set adoRecordset = adoCommand.Execute
      ' Enumerate the resulting recordset.
      Do Until adoRecordset.EOF
          ' Retrieve values and display.    
          For intCount = LBound(arrProperties) To UBound(arrProperties)
                If strDetails = "" Then
                      strDetails = adoRecordset.Fields(intCount).Value
                Else
                      strDetails = strDetails & VbCrLf & adoRecordset.Fields(intCount).Value
                End If
          Next
          ' Move to the next record in the recordset.
          adoRecordset.MoveNext
      Loop

      ' Clean up.
      adoRecordset.Close
      adoConnection.Close
      Get_LDAP_User_Properties = strDetails

End Function

'Function to convert OctetString (byte array) to Hex string.
Function OctetToHexStr(arrbytOctet)
      Dim k
      OctetToHexStr = ""
      For k = 1 To Lenb(arrbytOctet)
            OctetToHexStr = OctetToHexStr & Right("0" & Hex(Ascb(Midb(arrbytOctet, k, 1))), 2)
      Next
End Function

' Function to convert hex Sid to decimal (SDDL) Sid.
Function HexSIDtoSDDL(strHexSID)
      Dim i
      Dim strA, strB, strC, strD, strE, strF, strG
      ReDim arrTemp(Len(strHexSID)/2 - 1)
     
      'Create an array, where each element contains a single byte from the hex number
      For i = 0 To UBound(arrTemp)
            arrTemp(i) = Mid(strHexSID, 2 * i + 1, 2)
      Next

      'Move through the array to get each section, then convert it to decimal format
      strA = CInt(arrTemp(0))
      For i = 0 To UBound(arrTemp) 'Forward cycle for big-endian format
            Select Case i
                  Case 2 strB = strB & arrTemp(i)
                  Case 3 strB = strB & arrTemp(i)
                  Case 4 strB = strB & arrTemp(i)
                  Case 5 strB = strB & arrTemp(i)
                  Case 6 strB = strB & arrTemp(i)
                  Case 7 strB = strB & arrTemp(i)
            End Select
      Next
      strB = CInt("&H" & strB)

      For i = UBound(arrTemp) To 0 Step -1 'Reverse cycle for little-endian format
            Select Case i
                  Case 11 strC = strC & arrTemp(i)
                  Case 10 strC = strC & arrTemp(i)
                  Case 9 strC = strC & arrTemp(i)
                  Case 8 strC = strC & arrTemp(i)
            End Select
      Next
      strC = CInt("&H" & strC)

      For i = UBound(arrTemp) To 0 Step -1 'Reverse cycle for little-endian format
            Select Case i
                  Case 15 strD = strD & arrTemp(i)
                  Case 14 strD = strD & arrTemp(i)
                  Case 13 strD = strD & arrTemp(i)
                  Case 12 strD = strD & arrTemp(i)
            End Select
      Next
      strD = CLng("&H" & strD)

      For i = UBound(arrTemp) To 0 Step -1 'Reverse cycle for little-endian format
            Select Case i
                  Case 19 strE = strE & arrTemp(i)
                  Case 18 strE = strE & arrTemp(i)
                  Case 17 strE = strE & arrTemp(i)
                  Case 16 strE = strE & arrTemp(i)
            End Select
      Next
      strE = CLng("&H" & strE)

      For i = UBound(arrTemp) To 0 Step -1 'Reverse cycle for little-endian format
            Select Case i
                  Case 23 strF = strF & arrTemp(i)
                  Case 22 strF = strF & arrTemp(i)
                  Case 21 strF = strF & arrTemp(i)
                  Case 20 strF = strF & arrTemp(i)
            End Select
      Next
      strF = CLng("&H" & strF)

      For i = UBound(arrTemp) To 0 Step -1 'Reverse cycle for little-endian format
            Select Case i
                  Case 27 strG = strG & arrTemp(i)
                  Case 26 strG = strG & arrTemp(i)
                  Case 25 strG = strG & arrTemp(i)
                  Case 24 strG = strG & arrTemp(i)
            End Select
      Next
      strG = CLng("&H" & strG)

      HexSIDtoSDDL = "S-" & strA & "-" & strB & "-" & strC & "-" & strD & "-" & strE & "-" & strF & "-" & strG

End Function
'====================

Sharath, a few posts back, in post ID: 19990655, you had this error:
---------------------------
Windows Script Host
---------------------------
Script:      C:\Website usercreation.vbs
Line:      3
Char:      9
Error:      Expected end of statement
Code:      800A0401
Source:       Microsoft VBScript compilation error

---------------------------
OK  
---------------------------



That refers to these three lines at the top:
Dim Row As Integer
Dim oMailbox As CDOEXM.IMailboxStore
Dim oUser As IADsUser

and the "As datatype" property is not supported in VBScript.  Also, judging by the direct "Cells" references in that code, this is not a VBS file at all.  It is designed to be run directly from an Excel macro.

Paste it into an Excel module and see how it goes...

Regards,

Rob.
Rob does this mean that this is a macro.

ID: 19991951

How should the file Headers look like.As mentioned in the links the text is there but not able to understand what they are...
Yes, it will be a macro....as far as I can tell, these give clues on the headers:
    gname = Trim(Cells(Row, 1).Value)
    sname = Trim(Cells(Row, 2).Value)
    ID = Cells(Row, 3).Value
    mailingaddress = Cells(Row, 4).Value
    city = Cells(Row, 5).Value
    postalcode = Cells(Row, 6).Value
    homephone = Cells(Row, 7).Value
    cellular = Cells(Row, 8).Value
    dept = Trim(Cells(Row, 9).Value)



where the 1, 2, 3, 4, 5, 6, 7, 8, 9 specify the column fields.

Rob.
I would suggest creating a new Excel spreadsheet.  Don't modify the existing one you have just yet....

Regards,

Rob.
Rob i have put the code in the new Module...
I have created the data in the excel..
How do i run it...
When i go to Run macro i dont see the macro name to run...
Are you sure you've got these lines
Sub CreateUsers()
...
' rest of code
...
End Sub


Also, make sure the new module you have inserted was created by opening the Visual Basic Editor (press ALT + F11), right click ThisWorkbook on the left, and click Insert --> Module, then paste the code on the right in the main window/

Regards,

Rob.
Yes Rob got it i copied the wrong code.

I get this...
---------------------------
Microsoft Visual Basic
---------------------------
Compile error:

I have taken the code from
ID: 19990655
User-defined type not defined
---------------------------
OK   Help  
---------------------------
If you click Debug, which line is highlighted for User Type Not Defined?

Rob.
Its highlighting these 2 lines

Sub CreateUsers()


Dim oMailbox As CDOEXM.IMailboxStore
Hi Sharath / Rob,

I think this would this would really help. The script that will really suit your needs

Option Explicit

On Error Resume Next

' Declare variables for input parameters.
Dim strDCServerName                  ' As String
Dim strExchServerName            ' As String
Dim strStorageGroup                  ' As String
Dim strMailboxStore                  ' As String
Dim strUserFileName                  ' As String
Dim strGivenName                  ' As String
Dim strSurname                        ' As String
Dim strAlias                        ' As String
Dim strPassword                        ' As String
Dim strCompany                        ' As String
Dim strDepartment                  ' As String
Dim strTelephone                  ' As String
Dim stremail                        ' As String
Dim bIsFound                        ' As Boolean
Dim i                                    ' As Integer
Dim vProxyAddresses                  ' As Array
Dim nProxyAddresses                  ' As Array
Dim strFolderLang                  ' As String
Dim strExternalAccount            ' As String
Dim strTrustedDomain            ' As String
Dim strLogFile                        ' As String

' Declare variables used for verifying the existance of the mailbox store
' where the mailbox is to be created.
Dim iDS                              ' As IDataSource
Dim iAdRootDSE                  ' As ActiveDs.IADs
Dim objServer                  ' CDOEXM.ExchangeServer
Dim objSG                        ' CDOEXM.StorageGroup
Dim objMSDB                        ' CDOEXM.MailboxStoreDB
Dim storegroup                  ' CDOEXM.MailboxStoreDB
Dim mbx                              ' CDOEXM.MailboxStoreDB
Dim bFound                        ' As Boolean
Dim CreateMailboxFolder      ' As Boolean

' Declare variables for iterating through the
' file of new users.
Dim objUser                        ' As IADsUser
Dim strDomainDN                  ' As String
Dim strLDAPUrl                  ' As String
Dim strOU                        ' As String
Dim arrNewUsersInfo            ' As Array
Dim strCurrUserInfo            ' As String
Dim arrCurrUserInfo            ' As Array
Dim fs                              ' As FileSystemObject
Dim filein                        ' As As fs.TextStream
Dim fileout                        ' As As fs.TextStream
Dim tsNewUsers                  ' As FSO.TextStream
Dim iLineNum                  ' As Integer
Dim bContinue                  ' As Boolean
Dim TimeInterval            ' As Integer
Dim NumofTry                  ' As Integer
Dim iCounter                  ' As Integer

' Get input parameters.
strDCServerName = "DC1"
strOU = "OU=OUName"
strUserFileName = "NewUsers.csv"
strPassword = "D0ntCh8ngeTh1s"
strLogFile = "Created_Users_and_Mailboxes.txt"
strFolderLang = "en-us"
CreateMailboxFolder = False

'Open the New_users filename to read in all contacts
Err.Clear
Set fs = CreateObject("Scripting.FileSystemObject")
Set fileout= fs.OpenTextFile(strlogfile,8,True)
If fs.fileexists(strUserFileName) Then
      Set filein = fs.OpenTextFile(strUserFileName, 1)
Else
      fileout.writeline:fileout.writeline("!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!")
      fileout.writeline
      fileout.writeline("Error reported on " & Now)
      fileout.writeline("Problem opening the New_users file. Make sure the " & strUserFileName & " file exists!")
      fileout.writeline
      fileout.writeline("!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!")
      WScript.Quit
End If

fileout.writeline:fileout.writeline("*************************************************************************************")
fileout.writeline("Beginning creation of new users and mailboxes on " & Now)
fileout.writeline

' Open the new users file.
Set tsNewUsers = fs.OpenTextFile(strUserFileName, 1, -1)

' Error handling.
If Err <> 0 Then
    fileout.writeline "An error occurred opening the file of new users."
    fileout.writeline "Error: " & Err.Number & " " & Err.Description
    fileout.writeline "Exiting the application."

    ' Clean up.
    Set fs = Nothing
    Set tsNewUsers = Nothing
    wscript.Quit
End If

' Get all lines from the new users file and split
' them into an array of strings.
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), "§", -1, 1)

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

               ' Get the given name, surname, e-mail alias, and password from the array.
             strGivenName = arrCurrUserInfo(1)
             strSurname = arrCurrUserInfo(2)
             strAlias = arrCurrUserInfo(0)
             strCompany = arrCurrUserInfo(3)
             strDepartment = arrCurrUserInfo(4)
             strTelephone = arrCurrUserInfo(5)
             strExchServerName = arrCurrUserInfo(6)
             strStorageGroup = arrCurrUserInfo(7)
             strMailboxStore = arrCurrUserInfo(8)
             strTrustedDomain = arrCurrUserInfo(9)
             strEmail = arrCurrUserInfo(10)
             'strPassword = arrCurrUserInfo(11)
                    
             strExternalAccount = strTrustedDomain & "\" & strAlias
      
             fileout.writeline "Beginning creation of " & strGivenName & " " & strSurname
      
                  ' Verify that the specified mailbox store exists.
                  ' Initialize bFound.
                  bFound = False
                  
                  ' Get the default naming context.
                  Set iAdRootDSE = GetObject("LDAP://RootDSE")
                  strDomainDN = iAdRootDSE.Get("defaultNamingContext")
                  
                  ' Create objects for verifying existance of
                  ' the mailbox store where the mailbox will be created.
                  Set objServer = CreateObject("CDOEXM.ExchangeServer")
                  Set objSG = CreateObject("CDOEXM.StorageGroup")
                  Set objMSDB = CreateObject("CDOEXM.MailboxStoreDB")
                  Set iDS = objServer.GetInterface("IDataSource")
                  
                  ' Bind to the Exchange server.
                  iDS.Open strExchServerName
                  
                  ' Check that the destination mailbox store exists.
                  For Each storegroup In objServer.StorageGroups
                     objSG.DataSource.Open storegroup
                  
                        ' Error handling.  If CDOEXM attempts to open a Recovery
                        ' Storage Group, a 0xC1032221 error will be returned.
                     If Err.Number <> 0 Then
                         fileout.writeline "An error occurred opening the specified storage group."
                         fileout.writeline "Error: 0x" & Hex(Err.Number) & " " & Err.Description
            
                         ' Clean up.
                         Set objSG = Nothing
                        
                         Exit For

                      End If
                  
                     If UCase(strStorageGroup) = UCase(objSG.Name) Then
                        For Each mbx In objSG.MailboxStoreDBs
                            objMSDB.DataSource.Open mbx
                            If UCase(strMailboxStore) = UCase(objMSDB.Name) Then
                                bFound = True
                                ' Get the LDAP URL for the mailbox store.
                                strLDAPUrl = "LDAP://" + mbx
                                Exit For
                            End If
                        Next
                     End If
                  
                     If bFound Then Exit For
                  Next
                  
                  ' Clean up.
                  Set objServer = Nothing
                  Set objSG = Nothing
                  Set objMSDB = Nothing
            
                  ' If the mailbox store was not found, exit the program.
                  If bFound = False Then
                      fileout.writeline "The specified mailbox store could not be found."
                  End If
      
                ' Validate the given and surnames.
                If ValidateName(strGivenName) = False Or ValidateName(strSurname) = False Then
                       bContinue = False
                End If
      
                ' Validate the e-mail alias.
                If ValidateAlias(strAlias) = False Then
                     bContinue = False
                End If

       Else
            fileout.writeline "The input line for user n° " & iLineNum + 1 & " has an incorrect syntax"
            bContinue = False
       End If

       ' ##################################################################################
        ' If input validation passed, then attempt to create the user object.
       If bContinue Then

          bContinue = CreateNewUser(strDCServerName, strGivenName, strSurname, strAlias, _
                                 strPassword, strCompany, strDepartment, strTelephone, objUser, strDomainDN)
       End If


       ' ##################################################################################       
       ' If the user object was successfully created, then attempt to create the mailbox.
     
     ' wait 1 second before creating the mailbox
    wscript.sleep(1000)
   
    If bContinue Then

              ' Initialize the variables.
        TimeInterval = 5000
        NumofTry = 120
        iCounter = 0

              ' Depending on the size of the network, the Recipient Update
              ' Service may take some time to propagate the new user
              ' to the Exchange server.  Attempt to create the mailbox every
              ' 5 seconds for 10 minutes.
        Do While iCounter < NumofTry

                        ' Attempt to create the mailbox in the specified
                        ' mailbox store.
            bContinue = CreateNewUserMailbox(objUser, strLDAPUrl)

            ' Continue if CreateNewUserMailbox succeeded.
            If bContinue Then Exit Do
            iCounter = iCounter + 1

            ' Wait before trying again.
            wscript.sleep(TimeInterval)
        Loop

              ' Could not create the mailbox after NumofTry attempts.
        If iCounter >= NumofTry Then
            bContinue = False
        End If
    End If


       ' ##################################################################################
       ' If the mailbox was created, then attempt to force the Exchange server to create the mailbox folders.
       ' First check if the mailbox folder needs to be created, because it can take a while
       ' for each account because of replication latency
      
       If CreateMailboxFolder = True then
          If bContinue Then
      
              ' Initialize the variables.
              TimeInterval = 5000
              NumofTry = 120
              iCounter = 0
      
                    ' Directory Service replication may take some time.  Attempt
                    ' to force the Exchange server to create the mailbox folders
                    ' every 5 seconds for 10 minutes.
              Do While iCounter < NumofTry
                  ' Wait for a certain time interval before trying again.
                  wscript.sleep(TimeInterval)
      
                  ' Attempt to force the Exchange server to create the
                              ' mailbox folders in the specified language..
                  If CreateMailboxFolders(strExchServerName, strDomainDN, strAlias, _
                                          strPassword, strFolderLang) Then Exit Do
                  iCounter = iCounter + 1
              Loop
      
                    ' Could not create the mailbox folders after NumofTry attempts.
              If iCounter >= NumofTry Then
                  fileout.writeline "... Failed to create the mailbox folders for " & strGivenName & " " & strSurname & " before logon."
              End If
          End If
    End If
   
              
       ' ##################################################################################
       ' If the mailbox was created, then attempt to change the ACL on the User objecct
      If bContinue Then
          
          bContinue = Add_ACE_ADUser(strSurName & " " & strGivenName & " " & strAlias)    
          
      End If
   

       ' ##################################################################################
       ' If the User object ACL list was changed, then attempt to change
       ' the ACL on the Mailbox objecct
    If bContinue Then
   
          bContinue = Add_ACE_Mailbox(strSurName & " " & strGivenName & " " & strAlias)    
   
    End If
   

       fileout.writeline("")

Next

' Close the file.
tsNewUsers.Close

' Clean up.
Set fs = Nothing
Set tsNewUsers = Nothing

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

MsgBox("Done")

' Exit the application.
wscript.Quit


'//////////////////////////////////////////////////////////////////////////////////
'// Function:  CreateNewUser
'//
'// Purpose:   Creates a new user in Active Directory with the specified given name,
'//            surname, e-mail alias, and password.
'//
'//
'// Input:     strDCServerName  = The domain controller on which the user
'//                               object will be created.
'//
'//            strGivenName     = The given name of the new user.
'//
'//            strSurname       =  The surname of the new user.
'//
'//            strAlias         = The e-mail alias of the new user.
'//
'//            strPassword      = The password for the new user.
'//
'//            strCompany           = The company for the new user.
'//
'//            strDepartment    = The department for the new user.
'//
'//            strTelephone     = The telephone for the new user.
'//
'//  Output:   objUser          = The user object for the new user.
'//
'//            strDomainDN      = The domain DN of the new user.
'//
'// Returns:   True if AD user object is created, False if it isn't.
'/////////////////////////////////////////////////////////////////////////////////
Function CreateNewUser(strDCServerName, strGivenName, strSurname, strAlias, _
                       strPassword, strCompany, strDepartment, strTelephone, objUser, strDomainDN)

    On Error Resume Next

    CreateNewUser = False

    ' Declare program variables.
    Dim objContainer     'As IADsContainer
    Dim strRecip         'As String

   ' Build the recipient string.
    strRecip = "CN=" & strSurName & " " & strGivenName & " " & strAlias

    '  Get the container.
    Set objContainer = GetObject("LDAP://" & strDCServerName & "/" & strOU & "," & strDomainDN)
    ' Initialize the user object.
    Set objUser = objContainer.Create("User", strRecip)

    ' Set the display name, account name, given name, surname, an
    ' and userprinciple properties of the user object.
    objUser.Put "displayname", strSurname & ", " & strGivenName
    objUser.Put "sAMAccountName", strAlias
    objUser.Put "givenName", strGivenName
    objUser.Put "sn", strSurname
    objUser.Put "company", strCompany
    objUser.Put "department", strDepartment
    objUser.Put "telephoneNumber", strTelephone
    objUser.Put "userPrincipalName", strAlias
    objUser.Put "mail", strEmail
   

       ' Save the changes to the user object.
    objUser.SetInfo
   
    ' Error handling.
    If Err.Number <> 0 Then
        fileout.writeline "... Error creating user object"
        fileout.writeline "... Error: " & Err.Number & " " & Err.Description

        ' Clean up.
        Set objContainer = Nothing
        Set objServer = Nothing
        Set objSG = Nothing
        Set objMSDB = Nothing

        If Err.Number = -2147019886 Then
            fileout.writeline "... The object already exists."
            CreateNewUser = False
            Exit Function
        End If

        CreateNewUser = False
        Exit Function
    End If

    ' Set the password for the new user.  This should be changed by the user
    ' after he or she logs on.
    objUser.SetPassword strPassword

    ' Enable the new user account.
    'objUser.AccountDisabled = False

    ' Clean up.
    Set objContainer = Nothing
    Set objServer = Nothing
    Set objSG = Nothing
    Set objMSDB = Nothing

       fileout.writeline "... Succesfully created user."

    CreateNewUser = True
End Function


'//////////////////////////////////////////////////////////////////////////////////
'// Function:  CreateNewUserMailbox
'//
'// Purpose:   Creates a mailbox for the new user in the specified
'//            mailbox store.
'//
'//
'// Input:     objUser    = The user object for the new user.
'//
'//            strLDAPUrl = The LDAP URL for the new user.
'//
'// Returns:   True if the mailbox is created, False if it isn't.
'/////////////////////////////////////////////////////////////////////////////////
Function CreateNewUserMailbox(objUser, strLDAPUrl)
    On Error Resume Next

    CreateNewUserMailbox = False

       ' Variables
    Dim objMailbox       'As CDOEXM.IMailboxStore

    ' Get the IMailboxStore interface.
    Set objMailbox = objUser

    ' Create a mailbox for the recipient on the specified Exchange server.
    objMailbox.CreateMailbox strLDAPUrl

    'Enable immediate-logon for the user.
    objUser.Put "msExchUserAccountControl", 2

      
    ' Save changes to the user object.
    objUser.SetInfo

    ' Error handling.
    If Err.Number <> 0 Then
        fileout.writeline "... Error creating mailbox."
        fileout.writeline "... Error: " & Err.Number & " " & Err.Description

        ' Clean up.
        Set objUser = Nothing
        Set objMailbox = Nothing

        CreateNewUserMailbox = False

        Exit Function
    End If

    ' Clean up.
    Set objUser = Nothing
    Set objMailbox = Nothing

    fileout.writeline "... Succesfully created mailbox."
    CreateNewUserMailbox = True
End Function


'//////////////////////////////////////////////////////////////////////////////////
'// Function:  CreateMailboxFolders
'//
'// Purpose:   Forces the specified Exchange server to create the user's mailbox
'//            folders if they don't already exist.
'//
'// Input:     strExchServerName = The Exchange server on which the mailbox
'//                            has been created.
'//
'//            strDomainDN   = The domain DN of the new user.
'//
'//            strAlias      = The e-mail alias of the new user.
'//
'//            strPassword   = The password for the new user.
'//
'//            strFolderLang = The language in which the mailbox
'//                            folders will be created.
'//
'/////////////////////////////////////////////////////////////////////////////////
Function CreateMailboxFolders(strExchServerName, strDomainDN, strAlias,  _
                                  strPassword, strFolderLang)
    On Error Resume Next

    CreateMailboxFolders = False

       ' Variables
    Dim strMailboxURL    'As String
      Dim strUserDomain    'As String

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

    ' Build the Domain\Username string.
    strUserDomain = Left(strDomainDN, InStr(1, strDomainDN, ",", vbTextCompare) - 1)
    strUserDomain = Right(strUserDomain, Len(strUserDomain) - 3) + "\" + strAlias

       ' Create the XMLHTTP object.
    Dim oXMLHTTP
    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", strFolderLang
    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
        fileout.writeline "... Mailbox folders successfully created."
        CreateMailboxFolders = True
    Else
        'GET method did not successfully force creation of mailbox folders.
        CreateMailboxFolders = False
    End If

       Set oXMLHTTP = Nothing
End Function

'//////////////////////////////////////////////////////////////////////////////////
'// Function:  ValidateInput
'//
'// Purpose:   Verifies that the specified server, mailbox store, or storage group name
'//            is not longer than 64 characters and doesn't contain any illegal characters.
'//
'// Input:     sInput    = The specified server, mailbox store, or storage group name.
'//
'// Returns:   True if the string is validated, False if it isn't.
'/////////////////////////////////////////////////////////////////////////////////
Function ValidateInput(sInput)
    ValidateInput = False

       Dim strPattern  'As String
       Dim regex               'As RegExp

       If Len(sInput) > 64 Then
        fileout.writeline "The length of the specified server, mailbox store, or storage group name" _
                     + " cannot exceed 64 characters."
        Exit Function
    End If

       ' Create the regular expression object.
       Set regex = New RegExp

       ' Set the pattern to search for.
       strPattern = ";|/|\\"
       regex.Pattern = strPattern
       regex.Global = True

    ' Exit the application if ';', '\', or '/'
       ' is found in the input string.
       If regex.Test(sInput) Then
          fileout.writeline "The specified server, mailbox store, or storage group name cannot contain ';', '\', or '/'."

          ' Clean up.
          Set regex = Nothing

          ' Exit the application.
             Exit Function
       End If

       ' Clean up.
       Set regex = Nothing

    ValidateInput = True
End Function

'//////////////////////////////////////////////////////////////////////////////////
'// Function:  ValidateAlias
'//
'// Purpose:   Verifies that the specified e-mail alias is not longer than 256
'//            characters, doesn't contain any illegal characters.
'//
'// Input:     sInput = The specified e-mail alias.
'//
'// Returns:   True if the string is validated, False if it isn't.
'/////////////////////////////////////////////////////////////////////////////////

Function ValidateAlias(sInput)
    ValidateAlias = False

       Dim strPattern  'As String
       Dim regex               'As RegExp

    If Len(sInput) > 256 Then
        fileout.writeline "The length of the e-mail alias cannot exceed 256 characters."
        Exit Function
    End If

       ' Create the regular expression object.
       Set regex = New RegExp

       ' Set the pattern to search for.
       strPattern = ":|\*|;|<|>|\||\"""
       regex.Pattern = strPattern
       regex.Global = True

       ' Exit the application if ';', '\', or '/'
       ' is found in the input string.
    If regex.Test(sInput) Then
          fileout.writeline "The specified server, mailbox store, or storage group name cannot contain ':', '*', " & _
                          " '|', ';', '<', '>', or '""'."

          ' Clean up.
          Set regex = Nothing

          ' Exit the application.
             Exit Function
       End If

       ' Clean up.
       Set regex = Nothing

    ValidateAlias = True
End Function

'//////////////////////////////////////////////////////////////////////////////////
'// Function:  ValidateName
'//
'// Purpose:   Verifies that the specified name is not longer than 28
'//            characters and doesn't contain the '<script' tag.
'//
'// Input:     sInput = The specified name.
'//
'// Returns:   True if the string is validated, False if it isn't.
'/////////////////////////////////////////////////////////////////////////////////

Function ValidateName(sInput)
    ValidateName = False

       Dim strPattern  'As String
       Dim regex               'As RegExp

    If Len(sInput) > 28 Then
        fileout.writeline "The length of the name cannot exceed 28 characters."
        Exit Function
    End If

       ' Create the regular expression object.
       Set regex = New RegExp

       ' Set the pattern to search for.
       strPattern = "<script"
       regex.Pattern = strPattern
       regex.Global = True

       ' Exit the application if "<script"
       ' is found in the input string.
    If regex.Test(sInput) Then
          fileout.writeline "The specified name cannot contain '<script'."

          ' Clean up.
          Set regex = Nothing

          ' Exit the application.
             Exit Function
       End If

       ' Clean up.
       Set regex = Nothing

    ValidateName = True
End Function


'//////////////////////////////////////////////////////////////////////////////////
'// 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
      
      Add_ACE_ADUser = False
      
      Set oUser = GetObject ("LDAP://cn=" & strADUser & "," & strOU & "," & strDomainDN)
      Set oSecurityDescriptor = oUser.Get("ntSecurityDescriptor")
      
      Err.Clear
      
      ' Extract the Discretionary Access Control List (DACL) using the IADsSecurityDescriptor.
      ' Interface.
      Set dacl = oSecurityDescriptor.DiscretionaryAcl
      Set ace = CreateObject("AccessControlEntry")
      
      ' Template: AddAce(TrusteeName, gAccessMask, gAceType, gAceFlags, gFlags, gObjectType, gInheritedObjectType)
       AddAce dacl,strExternalAccount,&H20014,0,0,1,0,0      '&H20014 -> gives Read permissions
       AddAce dacl,strExternalAccount,&H100,5,0,1,"{AB721A54-1E2F-11D0-9819-00AA0040529B}",0      '&H100 & the string -> enables the Send As permissions
      
       ' Add the modified DACL to the security descriptor.
       oSecurityDescriptor.DiscretionaryAcl = dacl
      
       ' Save new SD onto the user.
       oUser.Put "ntSecurityDescriptor",Array(oSecurityDescriptor)
      
       ' Commit changes from the property cache to the information store.
       oUser.SetInfo
      
       If Err.Number <> 0 Then
             fileout.writeline "... Failed to give the 'Read' & 'Send As' 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
      
       fileout.writeline "... Succesfully added the 'Read' & 'Send As' permissions to the account."
      
       '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
      
      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,131079,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

Sharath, can you give it a try......

regards
Chandru
Chandru is this a Vba file...
What are the changes i need to do in this...
I just created a csv file and i got this...


*************************************************************************************
Beginning creation of new users and mailboxes on 10/3/2007 1:07:57 PM

The input line for user n° 1 has an incorrect syntax

The input line for user n° 2 has an incorrect syntax


Creation of users and mailboxes ended on 10/3/2007 1:08:01 PM: 2 users processed.
*************************************************************************************


How should the Csv file be?
Here is the csv file format....

Alias,First Name,Last Name,CompanyName,Department,Telephone number,Exchange Server,First Storage Group,Mailbox Store,Domain Name,email address
Chandru

I have changed these parts.

' Get input parameters.
strDCServerName = "indc01"
strOU = "OU=Named Accounts"
strUserFileName = "NewUsers.csv"
strPassword = "abc123"
strLogFile = "Created_Users_and_Mailboxes.txt"
strFolderLang = "en-us"
CreateMailboxFolder = False

The csv is as you mentioned...

Still get this message..



*************************************************************************************
Beginning creation of new users and mailboxes on 10/3/2007 1:27:31 PM

The input line for user n° 1 has an incorrect syntax

The input line for user n° 2 has an incorrect syntax


Creation of users and mailboxes ended on 10/3/2007 1:27:35 PM: 2 users processed.
*************************************************************************************
Can i try in my setup and get back to you?
Ok...Thanks...
Hey guys, just a quick note from quickly looking at it, where Sharath is getting that error, the script is expecting 10 arguments to be passed to it....Chandru, if that makes sense to you, that might be the first place to look....

Rob.
Rob any way to tell which are the lines to change...
Sharath, the CSV format that Chandru listed is correct, however, by the look of this line:
arrCurrUserInfo = Split(arrNewUsersInfo(iLineNum), "§", -1, 1)

I would say that the delimiter is not a comma, it is that "§" symbol, so in your CSV file, open it with notepad, and change the Field delimiter to that symbol, and try again.....

Regards,

Rob.
Rob now a different one...


*************************************************************************************
Beginning creation of new users and mailboxes on 10/4/2007 12:19:54 PM

Beginning creation of Sharath Ramesh
An error occurred opening the specified storage group.
Error: 0x1A8 Object required
The specified mailbox store could not be found.
... Error creating user object
... Error: 424 Object required

The input line for user n° 2 has an incorrect syntax


Creation of users and mailboxes ended on 10/4/2007 12:19:58 PM: 2 users processed.
*************************************************************************************
Where should i mention the exchange,Storage name?
The field "First Storage Group", which is the 8th field.
That should be the exact name of one of your storage groups.

Rob.
Rob should i change these line according to my domain?

Option Explicit

On Error Resume Next

' Declare variables for input parameters.
Dim strDCServerName                  ' As String
Dim strExchServerName            ' As String
Dim strStorageGroup                  ' As String
Dim strMailboxStore                  ' As String
Dim strUserFileName                  ' As String
Dim strGivenName                  ' As String
Dim strSurname                        ' As String
Dim strAlias                        ' As String
Dim strPassword                        ' As String
Dim strCompany                        ' As String
Dim strDepartment                  ' As String
Dim strTelephone                  ' As String
Dim stremail                        ' As String
Dim bIsFound                        ' As Boolean
Dim i                                    ' As Integer
Dim vProxyAddresses                  ' As Array
Dim nProxyAddresses                  ' As Array
Dim strFolderLang                  ' As String
Dim strExternalAccount            ' As String
Dim strTrustedDomain            ' As String
Dim strLogFile                        ' As String

If yes then how?

Ex:
Dim str First storage                  ' As String
No, they are just variable declarations, which automatically get filled (through the rest of the script) from the values that you put in your text file.  See here:

             strGivenName = arrCurrUserInfo(1)
             strSurname = arrCurrUserInfo(2)
             strAlias = arrCurrUserInfo(0)
             strCompany = arrCurrUserInfo(3)
             strDepartment = arrCurrUserInfo(4)
             strTelephone = arrCurrUserInfo(5)
             strExchServerName = arrCurrUserInfo(6)
             strStorageGroup = arrCurrUserInfo(7)
             strMailboxStore = arrCurrUserInfo(8)
             strTrustedDomain = arrCurrUserInfo(9)
             strEmail = arrCurrUserInfo(10)

around about line 120 or so, is where it splits the info from the file into those values, so you wouldn't need to change anything.....

Regards,

Rob.
Rob sorry can you please paste the lines that i need to change :)
You shouldn't need to change any.....all you need to do is make sure that your CSV file contains the correct data for your environment....

Rob.
I have this in the csv file.

Ram§Sharath§Ramesh§Companyname§State§234624564§Exchangeservername§Storage Group§Travel§Domain§Sharath.adsfadf@plc.com
Is this correct
Yeah, but not if it is exactly
§Exchangeservername§Storage Group§Travel§Domain§

those values should be the actual display names of the exchange server, a storage group on that exchange server (usually something like "First Storage Group", the mailbox store name, and the domain.

Regards,

Rob.
YEs Rob all the details are exact but still get this error.


*************************************************************************************
Beginning creation of new users and mailboxes on 10/4/2007 12:54:37 PM

Beginning creation of Sharath Ramesh
An error occurred opening the specified storage group.
Error: 0x1A8 Object required
The specified mailbox store could not be found.
... Error creating user object
... Error: 424 Object required

The input line for user n° 2 has an incorrect syntax


Creation of users and mailboxes ended on 10/4/2007 12:54:41 PM: 2 users processed.
*************************************************************************************
Actually, it looks like it's not finding any storage groups for your Exchange Server name.....
Under this line:
For Each storegroup In objServer.StorageGroups

please put this line, to see if it's getting that far....
WScript.Echo "Attempting to open Storaget Group: " & storegroup & " on server: " & strExchangeServer

Regards,

Rob.
Rob i have placed the code as informed .But still get the error.


*************************************************************************************
Beginning creation of new users and mailboxes on 10/5/2007 8:11:32 AM

Beginning creation of Sharath Ramesh
An error occurred opening the specified storage group.
Error: 0x1A8 Object required
The specified mailbox store could not be found.
... Error creating user object
... Error: 424 Object required

The input line for user n° 2 has an incorrect syntax


Creation of users and mailboxes ended on 10/5/2007 8:11:36 AM: 2 users processed.
*************************************************************************************
OK, let's comment out the On Error Resume Next and see where the error is...please post the line you get the error on....

Rob.
Rob,

I have " On Error Resume Next" in say 5 places should i comment all.
I commented the first one on the top and got this

---------------------------
Windows Script Host
---------------------------
Script:      C:\Chandru User.vbs
Line:      148
Char:      19
Error:      ActiveX component can't create object: 'CDOEXM.ExchangeServer'
Code:      800A01AD
Source:       Microsoft VBScript runtime error

---------------------------
OK  
---------------------------
Right, there we go....you need to have Exchange Management Tools installed:
http://technet.microsoft.com/en-us/library/aa996691.aspx

Regards,

Rob.
Rob i am running this on the exchange itself now.

I get this...
---------------------------
Windows Script Host
---------------------------
Script:      C:\Chandru User.vbs
Line:      158
Char:      1
Error:      Variable is undefined: 'strExchangeServer'
Code:      800A01F4
Source:       Microsoft VBScript runtime error

---------------------------
OK  
---------------------------
Ooops, that was on the new line that I got you to put in:
WScript.Echo "Attempting to open Storaget Group: " & storegroup & " on server: " & strExchangeServer

should be:
WScript.Echo "Attempting to open Storaget Group: " & storegroup & " on server: " & strExchServerName

Rob.
I get this...

---------------------------
Windows Script Host
---------------------------
Attempting to open Storaget Group: CN=First Storage Group,CN=InformationStore,CN=INEXCHANGE1,CN=Servers,CN=First Administrative Group,CN=Administrative Groups,CN=Group,CN=Microsoft Exchange,CN=Services,CN=Configuration,DC=Group,DC=co,DC=uk on server: Inexchange1
---------------------------
OK  
---------------------------


---------------------------
Windows Script Host
---------------------------
Attempting to open Storaget Group: CN=Second Storage Group,CN=InformationStore,CN=INEXCHANGE1,CN=Servers,CN=First Administrative Group,CN=Administrative Groups,CN=Group,CN=Microsoft Exchange,CN=Services,CN=Configuration,DC=Group,DC=co,DC=uk on server: Inexchange1
---------------------------
OK  
---------------------------
---------------------------

---------------------------
Done
---------------------------
OK  
---------------------------

After all the 3 messages i get this message in the log file


*************************************************************************************
Beginning creation of new users and mailboxes on 10/5/2007 8:51:48 AM

Beginning creation of Sharath Ramesh
... Error creating user object
... Error: 424 Object required

The input line for user n° 2 has an incorrect syntax


Creation of users and mailboxes ended on 10/5/2007 8:52:26 AM: 2 users processed.
*************************************************************************************
OK, so we're now down to about line 400.....on about line 368. just under that On Error Resume Next, put in
On Error GoTo 0

which will start displaying errors.  Flag this for deletion later when it starts working.

Then, with that in, post the error you get this time...

Rob.
Rob the 2nd line is On error resume just below it i pasted the code.

I get this now.

---------------------------
Windows Script Host
---------------------------
Script:      C:\Chandru User.vbs
Line:      155
Char:      19
Error:      The RPC server is unavailable.

Facility: Win32
ID no: c00706ba
Microsoft CDO for Exchange Management

Code:      8000FFFF
Source:       (null)

---------------------------
OK  
---------------------------

After this when i ran it just shows the storage path and come as Done.In the log i get the same error.
Hmmm, I wonder why that's back on line 155?  Odd.....I'm going on lunch, back soon.

Wait....you need to change these values:
strDCServerName = "DC1"
strOU = "OU=OUName"

at around line 60, to match (a) the server name of your DC, and (b) the OU path that you want to create the user in, in the AD.  This will actually create the User in the AD....

Regards,

Rob.
Rob i already have set them...
' Get input parameters.
strDCServerName = "indc01"
strOU = "OU=Named Accounts"
strUserFileName = "NewUsers.csv"
strPassword = "abc123"

Now i dont get that error. I just get the [previously pasted " Attempting to open " 2 times for storages and then Done.Just the error message in the log file as mentioned above.

I have the first 3 line like this...

Option Explicit
'On Error Resume Next
On Error GoTo 0
Does your log file have any more info in it?  From what I can see, just befoer "Done" there are a couple of WriteLines that should add
Creation of users and mailboxes ended on <date>: <number> users processed.

Rob.
No rob that the only data the log file has...

Can you explain this part please...

Creation of users and mailboxes ended on <date>: <number> users processed.

I have this in the csv file.

Ba§Sharath§Ramesh§Comp§Chennai§234624564§Inexchange1§Second Storage Group§CIO Services§Development§Sharath.ramesh@tplc.com

OK, if we go from a "clean slate", delete the user object from the AD that you are trying to create, and any mail file (alternatively change the name details to that of a test account), then run the script again.

That line I quoted:
>> Creation of users and mailboxes ended on <date>: <number> users processed

should be in the log file at the end, after it has run successfully.

@ Chandru, are you still around?  I could use your help with being able to test it in your environment....

Regards,

Rob.
Rob there is no user or mailbox that's there in ADS that's created by the script.

I have changed the names in the csv file and tryed.

I get the same mesaage.


*************************************************************************************
Beginning creation of new users and mailboxes on 10/5/2007 11:11:53 AM

Beginning creation of harish Chandra
... Error creating user object
... Error: 424 Object required

The input line for user n° 2 has an incorrect syntax


Creation of users and mailboxes ended on 10/5/2007 11:12:03 AM: 2 users processed.
*************************************************************************************


Do you mean this line in the script.

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

It is not Quoted...
Yeah, that line is fine, you can see that the last line in your log file is that line, which is fine.

It should error out before getting to the
... Error creating user object

At about line 368, you will see these lines:
    On Error Resume Next

    CreateNewUser = False


Can you please add On Error Goto 0 in the middle of those so it looks like this:
    On Error Resume Next
    On Error GoTo 0
    CreateNewUser = False


then run again?

Regards,

Rob.
I get this now...
---------------------------
Windows Script Host
---------------------------
Script:      C:\Chandru User.vbs
Line:      383
Char:      5
Error:      There is no such object on the server.
Code:      80072030
Source:       (null)

---------------------------
OK  
---------------------------
Right, so that's most likely this line, with finding the OU container:
Set objContainer = GetObject("LDAP://" & strDCServerName & "/" & strOU & "," & strDomainDN)

This isn't going to be a cross-domain issue again is it?  Is it on the same domain?

Regards,

Rob.
Are you talking about exchange.
Yes exchange is in the same domain...
What about the DC that it is connecting to on the AD?

Around line 383, change those lines there to this:
    '  Get the container.
    WScript.Echo "Attempting to connect to: " & "LDAP://" & strDCServerName & "/" & strOU & "," & strDomainDN
    Set objContainer = GetObject("LDAP://" & strDCServerName & "/" & strOU & "," & strDomainDN)


which just adds one line to the middle of what's already there.  Run again, and see if the OU path is correct.....we may run a small separate VBS to verify the existence of that object...

Rob.
Changing these 4lines
'  Get the container.
    Set objContainer = GetObject("LDAP://" & strDCServerName & "/" & strOU & "," & strDomainDN)
    ' Initialize the user object.
    Set objUser = objContainer.Create("User", strRecip)
With the mentioned?
I changed the bove lines to this...
  Get the container.
    WScript.Echo "Attempting to connect to: " & "LDAP://" & strDCServerName & "/" & strOU & "," & strDomainDN
    Set objContainer = GetObject("LDAP://" & strDCServerName & "/" & strOU & "," & strDomainDN)

And i get this...
---------------------------
Windows Script Host
---------------------------
Script:      C:\Chandru User.vbs
Line:      382
Char:      3
Error:      Expected statement
Code:      800A0400
Source:       Microsoft VBScript compilation error

---------------------------
OK  
---------------------------
Do you still have
Get the container
commented out?  It should have an apostrophe in front of it...

Rob.
Oh, and leave these two lines there:
    ' Initialize the user object.
    Set objUser = objContainer.Create("User", strRecip)

Rob.
Rob i get this...
---------------------------
Windows Script Host
---------------------------
Attempting to connect to: LDAP://indc01/OU=Named Accounts,DC=Development,DC=Group,DC=co,DC=uk
---------------------------
OK  
---------------------------

Then this error.

---------------------------
Windows Script Host
---------------------------
Script:      C:\Chandru User.vbs
Line:      384
Char:      5
Error:      There is no such object on the server.
Code:      80072030
Source:       (null)

---------------------------
OK  
---------------------------
named OU is inside many OU's should i specify the full path
Yes, absolutely!  Again, you'll need to specify that in reverse order.  So strOU should be:
strOU = "OU=Named Accounts,OU=Departments,OU=Sites"
which would equate to
development.group.co.uk/Sites/Departments/Named Accounts

Regards,

Rob.
Ha Rob...Now it has created the user and mail box....
Oh wow!  Nice one!

So the mailbox got created without errors?  Awesome, so we're done?  Can you post the full code for mine and Chandru's reference?

Thanks,

Rob.
I get this now...


*************************************************************************************
Beginning creation of new users and mailboxes on 10/5/2007 12:40:00 PM

Beginning creation of harish Chandra
... Succesfully created user.
... Succesfully created mailbox.
... Succesfully added the 'Read' & 'Send As' permissions to the account.
... Failed to give the 'Read', 'Full Mailbox Access' & 'Associate External Account' permissions to the account: Invalid Argument.

ID no: c103071f
Microsoft CDO for Exchange Management
(-2147024809).

The input line for user n° 2 has an incorrect syntax


Creation of users and mailboxes ended on 10/5/2007 12:40:22 PM: 2 users processed.
*************************************************************************************

Will it take time to reflect in exchange (Mailbox)
What all should i remove from the script.
Cant the symbol be changed to "," for the csv format

I do believe it will take some time to reflect in Exchange.   I have no idea what you can remove from the script, because I've never tested it, and don't know what's beiing used.  I will look at whether we can change the CSV to comma's on Monday.  I'm off home for the weekend now.

At least we got somewhere ;-)

Rob.
Ok Rob thanks a lot .have a great weekend....
Rob/Chandru,

Here is the code which worked...

Option Explicit

'On Error Resume Next
On Error GoTo 0

' Declare variables for input parameters.
Dim strDCServerName                  ' As String
Dim strExchServerName            ' As String
Dim strStorageGroup                  ' As String
Dim strMailboxStore                  ' As String
Dim strUserFileName                  ' As String
Dim strGivenName                  ' As String
Dim strSurname                        ' As String
Dim strAlias                        ' As String
Dim strPassword                        ' As String
Dim strCompany                        ' As String
Dim strDepartment                  ' As String
Dim strTelephone                  ' As String
Dim stremail                        ' As String
Dim bIsFound                        ' As Boolean
Dim i                                    ' As Integer
Dim vProxyAddresses                  ' As Array
Dim nProxyAddresses                  ' As Array
Dim strFolderLang                  ' As String
Dim strExternalAccount            ' As String
Dim strTrustedDomain            ' As String
Dim strLogFile                        ' As String

' Declare variables used for verifying the existance of the mailbox store
' where the mailbox is to be created.
Dim iDS                              ' As IDataSource
Dim iAdRootDSE                  ' As ActiveDs.IADs
Dim objServer                  ' CDOEXM.ExchangeServer
Dim objSG                        ' CDOEXM.StorageGroup
Dim objMSDB                        ' CDOEXM.MailboxStoreDB
Dim storegroup                  ' CDOEXM.MailboxStoreDB
Dim mbx                              ' CDOEXM.MailboxStoreDB
Dim bFound                        ' As Boolean
Dim CreateMailboxFolder      ' As Boolean

' Declare variables for iterating through the
' file of new users.
Dim objUser                        ' As IADsUser
Dim strDomainDN                  ' As String
Dim strLDAPUrl                  ' As String
Dim strOU                        ' As String
Dim arrNewUsersInfo            ' As Array
Dim strCurrUserInfo            ' As String
Dim arrCurrUserInfo            ' As Array
Dim fs                              ' As FileSystemObject
Dim filein                        ' As As fs.TextStream
Dim fileout                        ' As As fs.TextStream
Dim tsNewUsers                  ' As FSO.TextStream
Dim iLineNum                  ' As Integer
Dim bContinue                  ' As Boolean
Dim TimeInterval            ' As Integer
Dim NumofTry                  ' As Integer
Dim iCounter                  ' As Integer

' Get input parameters.
strDCServerName = "indc01"
strOU = "OU=Named Accounts,OU=User Accounts,OU=IND,OU=Countries"
strUserFileName = "NewUsers.csv"
strPassword = "abc123"
strLogFile = "Created_Users_and_Mailboxes.txt"
strFolderLang = "en-us"
CreateMailboxFolder = False

'Open the New_users filename to read in all contacts
Err.Clear
Set fs = CreateObject("Scripting.FileSystemObject")
Set fileout= fs.OpenTextFile(strlogfile,8,True)
If fs.fileexists(strUserFileName) Then
      Set filein = fs.OpenTextFile(strUserFileName, 1)
Else
      fileout.writeline:fileout.writeline("!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!")
      fileout.writeline
      fileout.writeline("Error reported on " & Now)
      fileout.writeline("Problem opening the New_users file. Make sure the " & strUserFileName & " file exists!")
      fileout.writeline
      fileout.writeline("!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!")
      WScript.Quit
End If

fileout.writeline:fileout.writeline("*************************************************************************************")
fileout.writeline("Beginning creation of new users and mailboxes on " & Now)
fileout.writeline

' Open the new users file.
Set tsNewUsers = fs.OpenTextFile(strUserFileName, 1, -1)

' Error handling.
If Err <> 0 Then
    fileout.writeline "An error occurred opening the file of new users."
    fileout.writeline "Error: " & Err.Number & " " & Err.Description
    fileout.writeline "Exiting the application."

    ' Clean up.
    Set fs = Nothing
    Set tsNewUsers = Nothing
    wscript.Quit
End If

' Get all lines from the new users file and split
' them into an array of strings.
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), "§", -1, 1)

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

               ' Get the given name, surname, e-mail alias, and password from the array.
             strGivenName = arrCurrUserInfo(1)
             strSurname = arrCurrUserInfo(2)
             strAlias = arrCurrUserInfo(0)
             strCompany = arrCurrUserInfo(3)
             strDepartment = arrCurrUserInfo(4)
             strTelephone = arrCurrUserInfo(5)
             strExchServerName = arrCurrUserInfo(6)
             strStorageGroup = arrCurrUserInfo(7)
             strMailboxStore = arrCurrUserInfo(8)
             strTrustedDomain = arrCurrUserInfo(9)
             strEmail = arrCurrUserInfo(10)
             'strPassword = arrCurrUserInfo(11)
                   
             strExternalAccount = strTrustedDomain & "\" & strAlias
     
             fileout.writeline "Beginning creation of " & strGivenName & " " & strSurname
     
                  ' Verify that the specified mailbox store exists.
                  ' Initialize bFound.
                  bFound = False
                 
                  ' Get the default naming context.
                  Set iAdRootDSE = GetObject("LDAP://RootDSE")
                  strDomainDN = iAdRootDSE.Get("defaultNamingContext")
                 
                  ' Create objects for verifying existance of
                  ' the mailbox store where the mailbox will be created.
                  Set objServer = CreateObject("CDOEXM.ExchangeServer")
                  Set objSG = CreateObject("CDOEXM.StorageGroup")
                  Set objMSDB = CreateObject("CDOEXM.MailboxStoreDB")
                  Set iDS = objServer.GetInterface("IDataSource")
                 
                  ' Bind to the Exchange server.
                  iDS.Open strExchServerName
                 
                  ' Check that the destination mailbox store exists.
                  For Each storegroup In objServer.StorageGroups
WScript.Echo "Attempting to open Storaget Group: " & storegroup & " on server: " & strExchServerName

                     objSG.DataSource.Open storegroup
                 
                        ' Error handling.  If CDOEXM attempts to open a Recovery
                        ' Storage Group, a 0xC1032221 error will be returned.
                     If Err.Number <> 0 Then
                         fileout.writeline "An error occurred opening the specified storage group."
                         fileout.writeline "Error: 0x" & Hex(Err.Number) & " " & Err.Description
           
                         ' Clean up.
                         Set objSG = Nothing
                         
                         Exit For

                      End If
                 
                     If UCase(strStorageGroup) = UCase(objSG.Name) Then
                        For Each mbx In objSG.MailboxStoreDBs
                            objMSDB.DataSource.Open mbx
                            If UCase(strMailboxStore) = UCase(objMSDB.Name) Then
                                bFound = True
                                ' Get the LDAP URL for the mailbox store.
                                strLDAPUrl = "LDAP://" + mbx
                                Exit For
                            End If
                        Next
                     End If
                 
                     If bFound Then Exit For
                  Next
                 
                  ' Clean up.
                  Set objServer = Nothing
                  Set objSG = Nothing
                  Set objMSDB = Nothing
           
                  ' If the mailbox store was not found, exit the program.
                  If bFound = False Then
                      fileout.writeline "The specified mailbox store could not be found."
                  End If
     
                ' Validate the given and surnames.
                If ValidateName(strGivenName) = False Or ValidateName(strSurname) = False Then
                       bContinue = False
                End If
     
                ' Validate the e-mail alias.
                If ValidateAlias(strAlias) = False Then
                     bContinue = False
                End If

       Else
            fileout.writeline "The input line for user n° " & iLineNum + 1 & " has an incorrect syntax"
            bContinue = False
       End If

       ' ##################################################################################
        ' If input validation passed, then attempt to create the user object.
       If bContinue Then

          bContinue = CreateNewUser(strDCServerName, strGivenName, strSurname, strAlias, _
                                 strPassword, strCompany, strDepartment, strTelephone, objUser, strDomainDN)
       End If


       ' ##################################################################################      
       ' If the user object was successfully created, then attempt to create the mailbox.
     
     ' wait 1 second before creating the mailbox
    wscript.sleep(1000)
   
    If bContinue Then

              ' Initialize the variables.
        TimeInterval = 5000
        NumofTry = 120
        iCounter = 0

              ' Depending on the size of the network, the Recipient Update
              ' Service may take some time to propagate the new user
              ' to the Exchange server.  Attempt to create the mailbox every
              ' 5 seconds for 10 minutes.
        Do While iCounter < NumofTry

                        ' Attempt to create the mailbox in the specified
                        ' mailbox store.
            bContinue = CreateNewUserMailbox(objUser, strLDAPUrl)

            ' Continue if CreateNewUserMailbox succeeded.
            If bContinue Then Exit Do
            iCounter = iCounter + 1

            ' Wait before trying again.
            wscript.sleep(TimeInterval)
        Loop

              ' Could not create the mailbox after NumofTry attempts.
        If iCounter >= NumofTry Then
            bContinue = False
        End If
    End If


       ' ##################################################################################
       ' If the mailbox was created, then attempt to force the Exchange server to create the mailbox folders.
       ' First check if the mailbox folder needs to be created, because it can take a while
       ' for each account because of replication latency
       
       If CreateMailboxFolder = True then
          If bContinue Then
     
              ' Initialize the variables.
              TimeInterval = 5000
              NumofTry = 120
              iCounter = 0
     
                    ' Directory Service replication may take some time.  Attempt
                    ' to force the Exchange server to create the mailbox folders
                    ' every 5 seconds for 10 minutes.
              Do While iCounter < NumofTry
                  ' Wait for a certain time interval before trying again.
                  wscript.sleep(TimeInterval)
     
                  ' Attempt to force the Exchange server to create the
                              ' mailbox folders in the specified language..
                  If CreateMailboxFolders(strExchServerName, strDomainDN, strAlias, _
                                          strPassword, strFolderLang) Then Exit Do
                  iCounter = iCounter + 1
              Loop
     
                    ' Could not create the mailbox folders after NumofTry attempts.
              If iCounter >= NumofTry Then
                  fileout.writeline "... Failed to create the mailbox folders for " & strGivenName & " " & strSurname & " before logon."
              End If
          End If
    End If
   
             
       ' ##################################################################################
       ' If the mailbox was created, then attempt to change the ACL on the User objecct
      If bContinue Then
         
          bContinue = Add_ACE_ADUser(strSurName & " " & strGivenName & " " & strAlias)    
         
      End If
   

       ' ##################################################################################
       ' If the User object ACL list was changed, then attempt to change
       ' the ACL on the Mailbox objecct
    If bContinue Then
   
          bContinue = Add_ACE_Mailbox(strSurName & " " & strGivenName & " " & strAlias)    
   
    End If
   

       fileout.writeline("")

Next

' Close the file.
tsNewUsers.Close

' Clean up.
Set fs = Nothing
Set tsNewUsers = Nothing

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

MsgBox("Done")

' Exit the application.
wscript.Quit


'//////////////////////////////////////////////////////////////////////////////////
'// Function:  CreateNewUser
'//
'// Purpose:   Creates a new user in Active Directory with the specified given name,
'//            surname, e-mail alias, and password.
'//
'//
'// Input:     strDCServerName  = The domain controller on which the user
'//                               object will be created.
'//
'//            strGivenName     = The given name of the new user.
'//
'//            strSurname       =  The surname of the new user.
'//
'//            strAlias         = The e-mail alias of the new user.
'//
'//            strPassword      = The password for the new user.
'//
'//            strCompany           = The company for the new user.
'//
'//            strDepartment    = The department for the new user.
'//
'//            strTelephone     = The telephone for the new user.
'//
'//  Output:   objUser          = The user object for the new user.
'//
'//            strDomainDN      = The domain DN of the new user.
'//
'// Returns:   True if AD user object is created, False if it isn't.
'/////////////////////////////////////////////////////////////////////////////////
Function CreateNewUser(strDCServerName, strGivenName, strSurname, strAlias, _
                       strPassword, strCompany, strDepartment, strTelephone, objUser, strDomainDN)

    On Error Resume Next
On Error GoTo 0
    CreateNewUser = False

    ' Declare program variables.
    Dim objContainer     'As IADsContainer
    Dim strRecip         'As String

   ' Build the recipient string.
    strRecip = "CN=" & strSurName & " " & strGivenName & " " & strAlias

  'Get the container.
    WScript.Echo "Attempting to connect to: " & "LDAP://" & strDCServerName & "/" & strOU & "," & strDomainDN
    Set objContainer = GetObject("LDAP://" & strDCServerName & "/" & strOU & "," & strDomainDN)



    '  Get the container.
    'Set objContainer = GetObject("LDAP://" & strDCServerName & "/" & strOU & "," & strDomainDN)
    ' Initialize the user object.
Set objUser = objContainer.Create("User", strRecip)

    ' Set the display name, account name, given name, surname, an
    ' and userprinciple properties of the user object.
    objUser.Put "displayname", strSurname & ", " & strGivenName
    objUser.Put "sAMAccountName", strAlias
    objUser.Put "givenName", strGivenName
    objUser.Put "sn", strSurname
    objUser.Put "company", strCompany
    objUser.Put "department", strDepartment
    objUser.Put "telephoneNumber", strTelephone
    objUser.Put "userPrincipalName", strAlias
    objUser.Put "mail", strEmail
   

       ' Save the changes to the user object.
    objUser.SetInfo
   
    ' Error handling.
    If Err.Number <> 0 Then
        fileout.writeline "... Error creating user object"
        fileout.writeline "... Error: " & Err.Number & " " & Err.Description

        ' Clean up.
        Set objContainer = Nothing
        Set objServer = Nothing
        Set objSG = Nothing
        Set objMSDB = Nothing

        If Err.Number = -2147019886 Then
            fileout.writeline "... The object already exists."
            CreateNewUser = False
            Exit Function
        End If

        CreateNewUser = False
        Exit Function
    End If

    ' Set the password for the new user.  This should be changed by the user
    ' after he or she logs on.
    objUser.SetPassword strPassword

    ' Enable the new user account.
    'objUser.AccountDisabled = False

    ' Clean up.
    Set objContainer = Nothing
    Set objServer = Nothing
    Set objSG = Nothing
    Set objMSDB = Nothing

       fileout.writeline "... Succesfully created user."

    CreateNewUser = True
End Function


'//////////////////////////////////////////////////////////////////////////////////
'// Function:  CreateNewUserMailbox
'//
'// Purpose:   Creates a mailbox for the new user in the specified
'//            mailbox store.
'//
'//
'// Input:     objUser    = The user object for the new user.
'//
'//            strLDAPUrl = The LDAP URL for the new user.
'//
'// Returns:   True if the mailbox is created, False if it isn't.
'/////////////////////////////////////////////////////////////////////////////////
Function CreateNewUserMailbox(objUser, strLDAPUrl)
    On Error Resume Next

    CreateNewUserMailbox = False

       ' Variables
    Dim objMailbox       'As CDOEXM.IMailboxStore

    ' Get the IMailboxStore interface.
    Set objMailbox = objUser

    ' Create a mailbox for the recipient on the specified Exchange server.
    objMailbox.CreateMailbox strLDAPUrl

    'Enable immediate-logon for the user.
    objUser.Put "msExchUserAccountControl", 2

     
    ' Save changes to the user object.
    objUser.SetInfo

    ' Error handling.
    If Err.Number <> 0 Then
        fileout.writeline "... Error creating mailbox."
        fileout.writeline "... Error: " & Err.Number & " " & Err.Description

        ' Clean up.
        Set objUser = Nothing
        Set objMailbox = Nothing

        CreateNewUserMailbox = False

        Exit Function
    End If

    ' Clean up.
    Set objUser = Nothing
    Set objMailbox = Nothing

    fileout.writeline "... Succesfully created mailbox."
    CreateNewUserMailbox = True
End Function


'//////////////////////////////////////////////////////////////////////////////////
'// Function:  CreateMailboxFolders
'//
'// Purpose:   Forces the specified Exchange server to create the user's mailbox
'//            folders if they don't already exist.
'//
'// Input:     strExchServerName = The Exchange server on which the mailbox
'//                            has been created.
'//
'//            strDomainDN   = The domain DN of the new user.
'//
'//            strAlias      = The e-mail alias of the new user.
'//
'//            strPassword   = The password for the new user.
'//
'//            strFolderLang = The language in which the mailbox
'//                            folders will be created.
'//
'/////////////////////////////////////////////////////////////////////////////////
Function CreateMailboxFolders(strExchServerName, strDomainDN, strAlias,  _
                                  strPassword, strFolderLang)
    On Error Resume Next

    CreateMailboxFolders = False

       ' Variables
    Dim strMailboxURL    'As String
      Dim strUserDomain    'As String

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

    ' Build the Domain\Username string.
    strUserDomain = Left(strDomainDN, InStr(1, strDomainDN, ",", vbTextCompare) - 1)
    strUserDomain = Right(strUserDomain, Len(strUserDomain) - 3) + "\" + strAlias

       ' Create the XMLHTTP object.
    Dim oXMLHTTP
    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", strFolderLang
    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
        fileout.writeline "... Mailbox folders successfully created."
        CreateMailboxFolders = True
    Else
        'GET method did not successfully force creation of mailbox folders.
        CreateMailboxFolders = False
    End If

       Set oXMLHTTP = Nothing
End Function

'//////////////////////////////////////////////////////////////////////////////////
'// Function:  ValidateInput
'//
'// Purpose:   Verifies that the specified server, mailbox store, or storage group name
'//            is not longer than 64 characters and doesn't contain any illegal characters.
'//
'// Input:     sInput    = The specified server, mailbox store, or storage group name.
'//
'// Returns:   True if the string is validated, False if it isn't.
'/////////////////////////////////////////////////////////////////////////////////
Function ValidateInput(sInput)
    ValidateInput = False

       Dim strPattern  'As String
       Dim regex               'As RegExp

       If Len(sInput) > 64 Then
        fileout.writeline "The length of the specified server, mailbox store, or storage group name" _
                     + " cannot exceed 64 characters."
        Exit Function
    End If

       ' Create the regular expression object.
       Set regex = New RegExp

       ' Set the pattern to search for.
       strPattern = ";|/|\\"
       regex.Pattern = strPattern
       regex.Global = True

    ' Exit the application if ';', '\', or '/'
       ' is found in the input string.
       If regex.Test(sInput) Then
          fileout.writeline "The specified server, mailbox store, or storage group name cannot contain ';', '\', or '/'."

          ' Clean up.
          Set regex = Nothing

          ' Exit the application.
             Exit Function
       End If

       ' Clean up.
       Set regex = Nothing

    ValidateInput = True
End Function

'//////////////////////////////////////////////////////////////////////////////////
'// Function:  ValidateAlias
'//
'// Purpose:   Verifies that the specified e-mail alias is not longer than 256
'//            characters, doesn't contain any illegal characters.
'//
'// Input:     sInput = The specified e-mail alias.
'//
'// Returns:   True if the string is validated, False if it isn't.
'/////////////////////////////////////////////////////////////////////////////////

Function ValidateAlias(sInput)
    ValidateAlias = False

       Dim strPattern  'As String
       Dim regex               'As RegExp

    If Len(sInput) > 256 Then
        fileout.writeline "The length of the e-mail alias cannot exceed 256 characters."
        Exit Function
    End If

       ' Create the regular expression object.
       Set regex = New RegExp

       ' Set the pattern to search for.
       strPattern = ":|\*|;|<|>|\||\"""
       regex.Pattern = strPattern
       regex.Global = True

       ' Exit the application if ';', '\', or '/'
       ' is found in the input string.
    If regex.Test(sInput) Then
          fileout.writeline "The specified server, mailbox store, or storage group name cannot contain ':', '*', " & _
                          " '|', ';', '<', '>', or '""'."

          ' Clean up.
          Set regex = Nothing

          ' Exit the application.
             Exit Function
       End If

       ' Clean up.
       Set regex = Nothing

    ValidateAlias = True
End Function

'//////////////////////////////////////////////////////////////////////////////////
'// Function:  ValidateName
'//
'// Purpose:   Verifies that the specified name is not longer than 28
'//            characters and doesn't contain the '<script' tag.
'//
'// Input:     sInput = The specified name.
'//
'// Returns:   True if the string is validated, False if it isn't.
'/////////////////////////////////////////////////////////////////////////////////

Function ValidateName(sInput)
    ValidateName = False

       Dim strPattern  'As String
       Dim regex               'As RegExp

    If Len(sInput) > 28 Then
        fileout.writeline "The length of the name cannot exceed 28 characters."
        Exit Function
    End If

       ' Create the regular expression object.
       Set regex = New RegExp

       ' Set the pattern to search for.
       strPattern = "<script"
       regex.Pattern = strPattern
       regex.Global = True

       ' Exit the application if "<script"
       ' is found in the input string.
    If regex.Test(sInput) Then
          fileout.writeline "The specified name cannot contain '<script'."

          ' Clean up.
          Set regex = Nothing

          ' Exit the application.
             Exit Function
       End If

       ' Clean up.
       Set regex = Nothing

    ValidateName = True
End Function


'//////////////////////////////////////////////////////////////////////////////////
'// 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
     
      Add_ACE_ADUser = False
     
      Set oUser = GetObject ("LDAP://cn=" & strADUser & "," & strOU & "," & strDomainDN)
      Set oSecurityDescriptor = oUser.Get("ntSecurityDescriptor")
     
      Err.Clear
     
      ' Extract the Discretionary Access Control List (DACL) using the IADsSecurityDescriptor.
      ' Interface.
      Set dacl = oSecurityDescriptor.DiscretionaryAcl
      Set ace = CreateObject("AccessControlEntry")
     
      ' Template: AddAce(TrusteeName, gAccessMask, gAceType, gAceFlags, gFlags, gObjectType, gInheritedObjectType)
       AddAce dacl,strExternalAccount,&H20014,0,0,1,0,0      '&H20014 -> gives Read permissions
       AddAce dacl,strExternalAccount,&H100,5,0,1,"{AB721A54-1E2F-11D0-9819-00AA0040529B}",0      '&H100 & the string -> enables the Send As permissions
     
       ' Add the modified DACL to the security descriptor.
       oSecurityDescriptor.DiscretionaryAcl = dacl
     
       ' Save new SD onto the user.
       oUser.Put "ntSecurityDescriptor",Array(oSecurityDescriptor)
     
       ' Commit changes from the property cache to the information store.
       oUser.SetInfo
       
       If Err.Number <> 0 Then
             fileout.writeline "... Failed to give the 'Read' & 'Send As' 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
       
       fileout.writeline "... Succesfully added the 'Read' & 'Send As' permissions to the account."
       
       '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
     
      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,131079,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


Required a bit of tuning .
Chandru please check and help if possible this weekend...
Hi Guys,

I think you are almost done. Let me have a look and see

Hi Sharath,

Can you change this line "CreateMailboxFolder = False"

to the below

"CreateMailboxFolder = True"

This is the one which creates the mailbox in the exchange server. If not the mailbox will be created normally when the user logs on the first time

We need to also strip out some of the code. I will work on the final code you have pasted and will paste the final code

regards
Chandru
Hi Sharath,
Here is the final code.............

1) Create a new AD User
2) Create a mailbox for this user
3) Create the physical mailbox on the Exchange server (optional, not necessary for this script to work)

'Create script
Option Explicit

'On Error Resume Next
On Error GoTo 0

' Declare variables for input parameters.
Dim strDCServerName              ' As String
Dim strExchServerName            ' As String
Dim strStorageGroup              ' As String
Dim strMailboxStore              ' As String
Dim strUserFileName              ' As String
Dim strGivenName                 ' As String
Dim strSurname                   ' As String
Dim strAlias                     ' As String
Dim strPassword                  ' As String
Dim strCompany                   ' As String
Dim strDepartment                ' As String
Dim strTelephone                 ' As String
Dim stremail                     ' As String
Dim bIsFound                     ' As Boolean
Dim i                            ' As Integer
Dim vProxyAddresses              ' As Array
Dim nProxyAddresses              ' As Array
Dim strFolderLang                ' As String
Dim strExternalAccount           ' As String
Dim strTrustedDomain             ' As String
Dim strLogFile                   ' As String

' Declare variables used for verifying the existance of the mailbox store
' where the mailbox is to be created.
Dim iDS                         ' As IDataSource
Dim iAdRootDSE                  ' As ActiveDs.IADs
Dim objServer                   ' CDOEXM.ExchangeServer
Dim objSG                       ' CDOEXM.StorageGroup
Dim objMSDB                     ' CDOEXM.MailboxStoreDB
Dim storegroup                  ' CDOEXM.MailboxStoreDB
Dim mbx                         ' CDOEXM.MailboxStoreDB
Dim bFound                      ' As Boolean
Dim CreateMailboxFolder         ' As Boolean

' Declare variables for iterating through the
' file of new users.
Dim objUser                     ' As IADsUser
Dim strDomainDN                 ' As String
Dim strLDAPUrl                  ' As String
Dim strOU                       ' As String
Dim arrNewUsersInfo             ' As Array
Dim strCurrUserInfo             ' As String
Dim arrCurrUserInfo             ' As Array
Dim fs                          ' As FileSystemObject
Dim filein                      ' As As fs.TextStream
Dim fileout                     ' As As fs.TextStream
Dim tsNewUsers                  ' As FSO.TextStream
Dim iLineNum                    ' As Integer
Dim bContinue                   ' As Boolean
Dim TimeInterval                ' As Integer
Dim NumofTry                    ' As Integer
Dim iCounter                    ' As Integer

' Get input parameters.
strDCServerName = "indc01"
strOU = "OU=Named Accounts,OU=User Accounts,OU=IND,OU=Countries"
strUserFileName = "NewUsers.csv"
strPassword = "D0ntCh8ngeTh1s"
strLogFile = "Created_Users_and_Mailboxes.txt"
strFolderLang = "en-us"
CreateMailboxFolder = True

'Open the New_users filename to read in all contacts
Err.Clear
Set fs = CreateObject("Scripting.FileSystemObject")
Set fileout= fs.OpenTextFile(strlogfile,8,True)
If fs.fileexists(strUserFileName) Then
      Set filein = fs.OpenTextFile(strUserFileName, 1)
Else
      fileout.writeline:fileout.writeline("!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!")
      fileout.writeline
      fileout.writeline("Error reported on " & Now)
      fileout.writeline("Problem opening the New_users file. Make sure the " & strUserFileName & " file exists!")
      fileout.writeline
      fileout.writeline("!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!")
      WScript.Quit
End If

fileout.writeline:fileout.writeline("*************************************************************************************")
fileout.writeline("Beginning creation of new users and mailboxes on " & Now)
fileout.writeline

' Open the new users file.
Set tsNewUsers = fs.OpenTextFile(strUserFileName, 1, -1)

' Error handling.
If Err <> 0 Then
    fileout.writeline "An error occurred opening the file of new users."
    fileout.writeline "Error: " & Err.Number & " " & Err.Description
    fileout.writeline "Exiting the application."

    ' Clean up.
    Set fs = Nothing
    Set tsNewUsers = Nothing
    wscript.Quit
End If

' Get all lines from the new users file and split
' them into an array of strings.
arrNewUsersInfo = Split(tsNewUsers.ReadAll, vbCrLF)'Chr(13))

' Iterate through the array of new users.
For iLineNum = 1 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), ",", -1, 1)

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

               ' Get the given name, surname, e-mail alias, and password from the array.
             strGivenName = arrCurrUserInfo(1)
Wscript.echo strGivenName
             strSurname = arrCurrUserInfo(2)
Wscript.echo strSurname
             strAlias = arrCurrUserInfo(0)
Wscript.echo strAlias
             strCompany = arrCurrUserInfo(3)
Wscript.echo strCompany
             strDepartment = arrCurrUserInfo(4)
Wscript.echo strDepartment
             strTelephone = arrCurrUserInfo(5)
Wscript.echo strTelephone
             strExchServerName = arrCurrUserInfo(6)
Wscript.echo strExchServerName
             strStorageGroup = arrCurrUserInfo(7)
Wscript.echo strStorageGroup
             strMailboxStore = arrCurrUserInfo(8)
Wscript.echo strMailboxStore
             strTrustedDomain = arrCurrUserInfo(9)
Wscript.echo strTrustedDomain
             strEmail = arrCurrUserInfo(10)
Wscript.echo strEmail
             'strPassword = arrCurrUserInfo(11)
                   
             strExternalAccount = strTrustedDomain & "\" & strAlias
     
             fileout.writeline "Beginning creation of " & strGivenName & " " & strSurname
     
                  ' Verify that the specified mailbox store exists.
                  ' Initialize bFound.
                  bFound = False
                 
                  ' Get the default naming context.
                  Set iAdRootDSE = GetObject("LDAP://RootDSE")
                  strDomainDN = iAdRootDSE.Get("defaultNamingContext")
                 
                  ' Create objects for verifying existance of
                  ' the mailbox store where the mailbox will be created.
                  Set objServer = CreateObject("CDOEXM.ExchangeServer")
                  Set objSG = CreateObject("CDOEXM.StorageGroup")
                  Set objMSDB = CreateObject("CDOEXM.MailboxStoreDB")
                  Set iDS = objServer.GetInterface("IDataSource")
                 
                  ' Bind to the Exchange server.
                  iDS.Open strExchServerName
                 
                  ' Check that the destination mailbox store exists.
                  For Each storegroup In objServer.StorageGroups
WScript.Echo "Attempting to open Storaget Group: " & storegroup & " on server: " & strExchServerName

                     objSG.DataSource.Open storegroup
                 
                        ' Error handling.  If CDOEXM attempts to open a Recovery
                        ' Storage Group, a 0xC1032221 error will be returned.
                     If Err.Number <> 0 Then
                         fileout.writeline "An error occurred opening the specified storage group."
                         fileout.writeline "Error: 0x" & Hex(Err.Number) & " " & Err.Description
           
                         ' Clean up.
                         Set objSG = Nothing
                         
                         Exit For

                      End If
                 
                     If UCase(strStorageGroup) = UCase(objSG.Name) Then
                        For Each mbx In objSG.MailboxStoreDBs
                            objMSDB.DataSource.Open mbx
                            If UCase(strMailboxStore) = UCase(objMSDB.Name) Then
                                bFound = True
                                ' Get the LDAP URL for the mailbox store.
                                strLDAPUrl = "LDAP://" + mbx
                                Exit For
                            End If
                        Next
                     End If
                 
                     If bFound Then Exit For
                  Next
                 
                  ' Clean up.
                  Set objServer = Nothing
                  Set objSG = Nothing
                  Set objMSDB = Nothing
           
                  ' If the mailbox store was not found, exit the program.
                  If bFound = False Then
                      fileout.writeline "The specified mailbox store could not be found."
                  End If
     
                ' Validate the given and surnames.
                If ValidateName(strGivenName) = False Or ValidateName(strSurname) = False Then
                       bContinue = False
                End If
     
                ' Validate the e-mail alias.
                If ValidateAlias(strAlias) = False Then
                     bContinue = False
                End If

       Else
            fileout.writeline "The input line for user n° " & iLineNum + 1 & " has an incorrect syntax"
            bContinue = False
       End If

       ' ##################################################################################
        ' If input validation passed, then attempt to create the user object.
       If bContinue Then

          bContinue = CreateNewUser(strDCServerName, strGivenName, strSurname, strAlias, _
                                 strPassword, strCompany, strDepartment, strTelephone, objUser, strDomainDN)
       End If


       ' ##################################################################################      
       ' If the user object was successfully created, then attempt to create the mailbox.
     
     ' wait 1 second before creating the mailbox
    wscript.sleep(1000)
   
    If bContinue Then

              ' Initialize the variables.
        TimeInterval = 5000
        NumofTry = 120
        iCounter = 0

              ' Depending on the size of the network, the Recipient Update
              ' Service may take some time to propagate the new user
              ' to the Exchange server.  Attempt to create the mailbox every
              ' 5 seconds for 10 minutes.
        Do While iCounter < NumofTry

                        ' Attempt to create the mailbox in the specified
                        ' mailbox store.
            bContinue = CreateNewUserMailbox(objUser, strLDAPUrl)

            ' Continue if CreateNewUserMailbox succeeded.
            If bContinue Then Exit Do
            iCounter = iCounter + 1

            ' Wait before trying again.
            wscript.sleep(TimeInterval)
        Loop

              ' Could not create the mailbox after NumofTry attempts.
        If iCounter >= NumofTry Then
            bContinue = False
        End If
    End If


       ' ##################################################################################
       ' If the mailbox was created, then attempt to force the Exchange server to create the mailbox folders.
       ' First check if the mailbox folder needs to be created, because it can take a while
       ' for each account because of replication latency
       
       If CreateMailboxFolder = True then
          If bContinue Then
     
              ' Initialize the variables.
              TimeInterval = 5000
              NumofTry = 120
              iCounter = 0
     
                    ' Directory Service replication may take some time.  Attempt
                    ' to force the Exchange server to create the mailbox folders
                    ' every 5 seconds for 10 minutes.
              Do While iCounter < NumofTry
                  ' Wait for a certain time interval before trying again.
                  wscript.sleep(TimeInterval)
     
                  ' Attempt to force the Exchange server to create the
                              ' mailbox folders in the specified language..
                  If CreateMailboxFolders(strExchServerName, strDomainDN, strAlias, _
                                          strPassword, strFolderLang) Then Exit Do
                  iCounter = iCounter + 1
              Loop
     
                    ' Could not create the mailbox folders after NumofTry attempts.
              If iCounter >= NumofTry Then
                  fileout.writeline "... Failed to create the mailbox folders for " & strGivenName & " " & strSurname & " before logon."
              End If
          End If
    End If

       fileout.writeline("")

Next

' Close the file.
tsNewUsers.Close

' Clean up.
Set fs = Nothing
Set tsNewUsers = Nothing

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

MsgBox("Done")

' Exit the application.
wscript.Quit


'//////////////////////////////////////////////////////////////////////////////////
'// Function:  CreateNewUser
'//
'// Purpose:   Creates a new user in Active Directory with the specified given name,
'//            surname, e-mail alias, and password.
'//
'//
'// Input:     strDCServerName  = The domain controller on which the user
'//                               object will be created.
'//
'//            strGivenName     = The given name of the new user.
'//
'//            strSurname       =  The surname of the new user.
'//
'//            strAlias         = The e-mail alias of the new user.
'//
'//            strPassword      = The password for the new user.
'//
'//            strCompany           = The company for the new user.
'//
'//            strDepartment    = The department for the new user.
'//
'//            strTelephone     = The telephone for the new user.
'//
'//  Output:   objUser          = The user object for the new user.
'//
'//            strDomainDN      = The domain DN of the new user.
'//
'// Returns:   True if AD user object is created, False if it isn't.
'/////////////////////////////////////////////////////////////////////////////////
Function CreateNewUser(strDCServerName, strGivenName, strSurname, strAlias, _
                       strPassword, strCompany, strDepartment, strTelephone, objUser, strDomainDN)

    On Error Resume Next
On Error GoTo 0
    CreateNewUser = False

    ' Declare program variables.
    Dim objContainer     'As IADsContainer
    Dim strRecip         'As String

   ' Build the recipient string.
    strRecip = "CN=" & strSurName & " " & strGivenName & " " & strAlias

  'Get the container.
    WScript.Echo "Attempting to connect to: " & "LDAP://" & strDCServerName & "/" & strOU & "," & strDomainDN
    Set objContainer = GetObject("LDAP://" & strDCServerName & "/" & strOU & "," & strDomainDN)



    '  Get the container.
    'Set objContainer = GetObject("LDAP://" & strDCServerName & "/" & strOU & "," & strDomainDN)
    ' Initialize the user object.
Set objUser = objContainer.Create("User", strRecip)

    ' Set the display name, account name, given name, surname, an
    ' and userprinciple properties of the user object.
    objUser.Put "displayname", strSurname & ", " & strGivenName
    objUser.Put "sAMAccountName", strAlias
    objUser.Put "givenName", strGivenName
    objUser.Put "sn", strSurname
    objUser.Put "company", strCompany
    objUser.Put "department", strDepartment
    objUser.Put "telephoneNumber", strTelephone
    objUser.Put "userPrincipalName", strAlias
    objUser.Put "mail", strEmail
   

       ' Save the changes to the user object.
    objUser.SetInfo
   
    ' Error handling.
    If Err.Number <> 0 Then
        fileout.writeline "... Error creating user object"
        fileout.writeline "... Error: " & Err.Number & " " & Err.Description

        ' Clean up.
        Set objContainer = Nothing
        Set objServer = Nothing
        Set objSG = Nothing
        Set objMSDB = Nothing

        If Err.Number = -2147019886 Then
            fileout.writeline "... The object already exists."
            CreateNewUser = False
            Exit Function
        End If

        CreateNewUser = False
        Exit Function
    End If

    ' Set the password for the new user.  This should be changed by the user
    ' after he or she logs on.
    objUser.SetPassword strPassword

    ' Enable the new user account.
    'objUser.AccountDisabled = False

    ' Clean up.
    Set objContainer = Nothing
    Set objServer = Nothing
    Set objSG = Nothing
    Set objMSDB = Nothing

       fileout.writeline "... Succesfully created user."

    CreateNewUser = True
End Function


'//////////////////////////////////////////////////////////////////////////////////
'// Function:  CreateNewUserMailbox
'//
'// Purpose:   Creates a mailbox for the new user in the specified
'//            mailbox store.
'//
'//
'// Input:     objUser    = The user object for the new user.
'//
'//            strLDAPUrl = The LDAP URL for the new user.
'//
'// Returns:   True if the mailbox is created, False if it isn't.
'/////////////////////////////////////////////////////////////////////////////////
Function CreateNewUserMailbox(objUser, strLDAPUrl)
    On Error Resume Next

    CreateNewUserMailbox = False

       ' Variables
    Dim objMailbox       'As CDOEXM.IMailboxStore

    ' Get the IMailboxStore interface.
    Set objMailbox = objUser

    ' Create a mailbox for the recipient on the specified Exchange server.
    objMailbox.CreateMailbox strLDAPUrl

    'Enable immediate-logon for the user.
    objUser.Put "msExchUserAccountControl", 2

     
    ' Save changes to the user object.
    objUser.SetInfo

    ' Error handling.
    If Err.Number <> 0 Then
        fileout.writeline "... Error creating mailbox."
        fileout.writeline "... Error: " & Err.Number & " " & Err.Description

        ' Clean up.
        Set objUser = Nothing
        Set objMailbox = Nothing

        CreateNewUserMailbox = False

        Exit Function
    End If

    ' Clean up.
    Set objUser = Nothing
    Set objMailbox = Nothing

    fileout.writeline "... Succesfully created mailbox."
    CreateNewUserMailbox = True
End Function


'//////////////////////////////////////////////////////////////////////////////////
'// Function:  CreateMailboxFolders
'//
'// Purpose:   Forces the specified Exchange server to create the user's mailbox
'//            folders if they don't already exist.
'//
'// Input:     strExchServerName = The Exchange server on which the mailbox
'//                            has been created.
'//
'//            strDomainDN   = The domain DN of the new user.
'//
'//            strAlias      = The e-mail alias of the new user.
'//
'//            strPassword   = The password for the new user.
'//
'//            strFolderLang = The language in which the mailbox
'//                            folders will be created.
'//
'/////////////////////////////////////////////////////////////////////////////////
Function CreateMailboxFolders(strExchServerName, strDomainDN, strAlias,  _
                                  strPassword, strFolderLang)
    On Error Resume Next

    CreateMailboxFolders = False

       ' Variables
    Dim strMailboxURL    'As String
      Dim strUserDomain    'As String

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

    ' Build the Domain\Username string.
    strUserDomain = Left(strDomainDN, InStr(1, strDomainDN, ",", vbTextCompare) - 1)
    strUserDomain = Right(strUserDomain, Len(strUserDomain) - 3) + "\" + strAlias

       ' Create the XMLHTTP object.
    Dim oXMLHTTP
    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", strFolderLang
    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
        fileout.writeline "... Mailbox folders successfully created."
        CreateMailboxFolders = True
    Else
        'GET method did not successfully force creation of mailbox folders.
        CreateMailboxFolders = False
    End If

       Set oXMLHTTP = Nothing
End Function

'//////////////////////////////////////////////////////////////////////////////////
'// Function:  ValidateInput
'//
'// Purpose:   Verifies that the specified server, mailbox store, or storage group name
'//            is not longer than 64 characters and doesn't contain any illegal characters.
'//
'// Input:     sInput    = The specified server, mailbox store, or storage group name.
'//
'// Returns:   True if the string is validated, False if it isn't.
'/////////////////////////////////////////////////////////////////////////////////
Function ValidateInput(sInput)
    ValidateInput = False

       Dim strPattern  'As String
       Dim regex               'As RegExp

       If Len(sInput) > 64 Then
        fileout.writeline "The length of the specified server, mailbox store, or storage group name" _
                     + " cannot exceed 64 characters."
        Exit Function
    End If

       ' Create the regular expression object.
       Set regex = New RegExp

       ' Set the pattern to search for.
       strPattern = ";|/|\\"
       regex.Pattern = strPattern
       regex.Global = True

    ' Exit the application if ';', '\', or '/'
       ' is found in the input string.
       If regex.Test(sInput) Then
          fileout.writeline "The specified server, mailbox store, or storage group name cannot contain ';', '\', or '/'."

          ' Clean up.
          Set regex = Nothing

          ' Exit the application.
             Exit Function
       End If

       ' Clean up.
       Set regex = Nothing

    ValidateInput = True
End Function

'//////////////////////////////////////////////////////////////////////////////////
'// Function:  ValidateAlias
'//
'// Purpose:   Verifies that the specified e-mail alias is not longer than 256
'//            characters, doesn't contain any illegal characters.
'//
'// Input:     sInput = The specified e-mail alias.
'//
'// Returns:   True if the string is validated, False if it isn't.
'/////////////////////////////////////////////////////////////////////////////////

Function ValidateAlias(sInput)
    ValidateAlias = False

       Dim strPattern  'As String
       Dim regex               'As RegExp

    If Len(sInput) > 256 Then
        fileout.writeline "The length of the e-mail alias cannot exceed 256 characters."
        Exit Function
    End If

       ' Create the regular expression object.
       Set regex = New RegExp

       ' Set the pattern to search for.
       strPattern = ":|\*|;|<|>|\||\"""
       regex.Pattern = strPattern
       regex.Global = True

       ' Exit the application if ';', '\', or '/'
       ' is found in the input string.
    If regex.Test(sInput) Then
          fileout.writeline "The specified server, mailbox store, or storage group name cannot contain ':', '*', " & _
                          " '|', ';', '<', '>', or '""'."

          ' Clean up.
          Set regex = Nothing

          ' Exit the application.
             Exit Function
       End If

       ' Clean up.
       Set regex = Nothing

    ValidateAlias = True
End Function

'//////////////////////////////////////////////////////////////////////////////////
'// Function:  ValidateName
'//
'// Purpose:   Verifies that the specified name is not longer than 28
'//            characters and doesn't contain the '<script' tag.
'//
'// Input:     sInput = The specified name.
'//
'// Returns:   True if the string is validated, False if it isn't.
'/////////////////////////////////////////////////////////////////////////////////

Function ValidateName(sInput)
    ValidateName = False

       Dim strPattern  'As String
       Dim regex               'As RegExp

    If Len(sInput) > 28 Then
        fileout.writeline "The length of the name cannot exceed 28 characters."
        Exit Function
    End If

       ' Create the regular expression object.
       Set regex = New RegExp

       ' Set the pattern to search for.
       strPattern = "<script"
       regex.Pattern = strPattern
       regex.Global = True

       ' Exit the application if "<script"
       ' is found in the input string.
    If regex.Test(sInput) Then
          fileout.writeline "The specified name cannot contain '<script'."

          ' Clean up.
          Set regex = Nothing

          ' Exit the application.
             Exit Function
       End If

       ' Clean up.
       Set regex = Nothing

    ValidateName = True
End Function


Can you add the first line with the below?
Alias,First Name,Last Name,CompanyName,Department,Telephone number,Exchange Server,First Storage Group,Mailbox Store,Domain Name,email address
Second line  should be your inputs

regards
Chandru

Hi chandru thanks a lot to take time...

I get this in the log...

*************************************************************************************
Beginning creation of new users and mailboxes on 10/6/2007 10:39:56 PM

The input line for user n° 2 has an incorrect syntax

The input line for user n° 3 has an incorrect syntax


Creation of users and mailboxes ended on 10/6/2007 10:40:00 PM: 3 users processed.
*************************************************************************************

In the csv file as you mentioned i have mentioned the headers and below it the content should i use "," Comma or the symbol which ROb mentioned "§"
Whoops! Sorry forgot to tell you that i have changed it to ","

Can you give it a try?
Can you poste the CSV file you are using?
Chandru tried changing it to "," still same message in the log file.

Here is the csv file...
Alias,First Name,Last Name,CompanyName,Department,Telephone number,Exchange Server,First Storage Group,Mailbox Store,Domain Name,email address
Rameshm,Ramesh,Mahesh,clara,IT,234624564,exchange1,Second Storage Group,Services,Development,Ramesh.mahesh@plc.com
Can u try changing the line
For iLineNum = 1 To UBound(arrNewUsersInfo)
to
For iLineNum = 0 To UBound(arrNewUsersInfo)

Can you make sure that no space after the first line of input?
Delete the first line "Alias,First Name,Last Name,CompanyName,Department,Telephone number,Exchange Server,First Storage Group,Mailbox Store,Domain Name,email address"
When i run the script i get all popups to click "ok" for each and every option and later no "Done" button come. The process Wscript.exe going on and on...
In the log i get user created and mailbox created.
I just checked ADS and i could see the use but in disabled state...Exchnage mailbos is also created fine.

1. Just need to work on the popups
2. Why is the process not finishing
3. getting the user as disabled.
Try deleting these lines or comment these lines...............

'Wscript.echo strGivenName
'Wscript.echo strSurname
'Wscript.echo strAlias
'Wscript.echo strCompany
'Wscript.echo strDepartment
'Wscript.echo strTelephone
'Wscript.echo strExchServerName
'Wscript.echo strStorageGroup
'Wscript.echo strMailboxStore
'Wscript.echo strTrustedDomain
'Wscript.echo strEmail

'WScript.Echo "Attempting to open Storaget Group: " & storegroup & " on server: " & strExchServerName
'WScript.Echo "Attempting to connect to: " & "LDAP://" & strDCServerName & "/" & strOU & "," & strDomainDN

To enable the account
Can you please uncomment the line?
objUser.AccountDisabled = False
Can u post the results?
Can you try changing this line?

MsgBox("Done")
to
Wscript.echo "Done"

Can you also see whether you are able to see find wscript.exe in the taskmanager?
Ya now the popup's dont come and the account creates enabled.

Next
1. In the created users propertied in account > User logon name  next to it is a drop down where i have domain names displayed i want the first 1 to be select while creating.
2. What is the first colum in the csv (Alias) can you remove it.
3. Next can we add in Title,Office,Description,Website,Mobile no,Phone no,Managername,Adding to groups all sort as the next step in finishing the whole package.
It is still taking a long time to finish for a single user.
As you have mentioned
3) Create the physical mailbox on the Exchange server (optional, not necessary for this script to work)
I think this is taking the time and failing.
after 15 min i get the done box.

Here is the data from the log...


*************************************************************************************
Beginning creation of new users and mailboxes on 10/7/2007 12:52:01 AM

Beginning creation of Ramesh Mahesh
... Succesfully created user.
... Succesfully created mailbox.
... Failed to create the mailbox folders for Ramesh Mahesh before logon.

The input line for user n° 2 has an incorrect syntax
Creation of users and mailboxes ended on 10/7/2007 1:02:17 AM: 2 users processed.
*************************************************************************************
Can you let me know where exchange server is located? If it is located locally it will not take time.
Its in the same machine where i am running the script.
Did you check on the error in the log...
Are you in office?

What version of exchange server?
No at home but can connect.
Its Exchange 2003.
Can you change this part of the script as this is taking time to because of looping 120 times.

       If CreateMailboxFolder = True then
          If bContinue Then
     
              ' Initialize the variables.
              TimeInterval = 5000
              NumofTry = 120
              iCounter = 0

to

       If CreateMailboxFolder = True then
          If bContinue Then
     
              ' Initialize the variables.
              TimeInterval = 60000
              NumofTry = 10
              iCounter = 0

Try this.........
Is the delay not because of this.
... Failed to create the mailbox folders for Ramesh Mahesh before logon.
As when i open the file in 2 min except this the success lines are created.
Fater 15 min only the ablove lines comes to the log.

I just checked after the chages but still take a long time.
Let me try the same in my setup with all the changes and get back to you tomorrow

My Exchange server is not in Chennai so i didn't get a chance to test this. I have a test setup where i can try.

 
Ok Chandru...Thanks...
You can see that the final code that i posted did not take this much of time.
But the previous code doesn't have the create mailbox folders enabled. I think that would be the reason
But the mailbox was also created with the code.It took a while to replicate but i could see the mailbox in ESM.
Can you post the code once again?
Here is the code.......


Option Explicit

'On Error Resume Next
On Error GoTo 0

' Declare variables for input parameters.
Dim strDCServerName                  ' As String
Dim strExchServerName            ' As String
Dim strStorageGroup                  ' As String
Dim strMailboxStore                  ' As String
Dim strUserFileName                  ' As String
Dim strGivenName                  ' As String
Dim strSurname                        ' As String
Dim strAlias                        ' As String
Dim strPassword                        ' As String
Dim strCompany                        ' As String
Dim strDepartment                  ' As String
Dim strTelephone                  ' As String
Dim stremail                        ' As String
Dim bIsFound                        ' As Boolean
Dim i                                    ' As Integer
Dim vProxyAddresses                  ' As Array
Dim nProxyAddresses                  ' As Array
Dim strFolderLang                  ' As String
Dim strExternalAccount            ' As String
Dim strTrustedDomain            ' As String
Dim strLogFile                        ' As String

' Declare variables used for verifying the existance of the mailbox store
' where the mailbox is to be created.
Dim iDS                              ' As IDataSource
Dim iAdRootDSE                  ' As ActiveDs.IADs
Dim objServer                  ' CDOEXM.ExchangeServer
Dim objSG                        ' CDOEXM.StorageGroup
Dim objMSDB                        ' CDOEXM.MailboxStoreDB
Dim storegroup                  ' CDOEXM.MailboxStoreDB
Dim mbx                              ' CDOEXM.MailboxStoreDB
Dim bFound                        ' As Boolean
Dim CreateMailboxFolder      ' As Boolean

' Declare variables for iterating through the
' file of new users.
Dim objUser                        ' As IADsUser
Dim strDomainDN                  ' As String
Dim strLDAPUrl                  ' As String
Dim strOU                        ' As String
Dim arrNewUsersInfo            ' As Array
Dim strCurrUserInfo            ' As String
Dim arrCurrUserInfo            ' As Array
Dim fs                              ' As FileSystemObject
Dim filein                        ' As As fs.TextStream
Dim fileout                        ' As As fs.TextStream
Dim tsNewUsers                  ' As FSO.TextStream
Dim iLineNum                  ' As Integer
Dim bContinue                  ' As Boolean
Dim TimeInterval            ' As Integer
Dim NumofTry                  ' As Integer
Dim iCounter                  ' As Integer

' Get input parameters.
strDCServerName = "indc01"
strOU = "OU=Named Accounts,OU=User Accounts,OU=IND,OU=Countries"
strUserFileName = "NewUsers.csv"
strPassword = "abc123"
strLogFile = "Created_Users_and_Mailboxes.txt"
strFolderLang = "en-us"
CreateMailboxFolder = False

'Open the New_users filename to read in all contacts
Err.Clear
Set fs = CreateObject("Scripting.FileSystemObject")
Set fileout= fs.OpenTextFile(strlogfile,8,True)
If fs.fileexists(strUserFileName) Then
      Set filein = fs.OpenTextFile(strUserFileName, 1)
Else
      fileout.writeline:fileout.writeline("!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!")
      fileout.writeline
      fileout.writeline("Error reported on " & Now)
      fileout.writeline("Problem opening the New_users file. Make sure the " & strUserFileName & " file exists!")
      fileout.writeline
      fileout.writeline("!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!")
      WScript.Quit
End If

fileout.writeline:fileout.writeline("*************************************************************************************")
fileout.writeline("Beginning creation of new users and mailboxes on " & Now)
fileout.writeline

' Open the new users file.
Set tsNewUsers = fs.OpenTextFile(strUserFileName, 1, -1)

' Error handling.
If Err <> 0 Then
    fileout.writeline "An error occurred opening the file of new users."
    fileout.writeline "Error: " & Err.Number & " " & Err.Description
    fileout.writeline "Exiting the application."

    ' Clean up.
    Set fs = Nothing
    Set tsNewUsers = Nothing
    wscript.Quit
End If

' Get all lines from the new users file and split
' them into an array of strings.
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), "§", -1, 1)

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

               ' Get the given name, surname, e-mail alias, and password from the array.
             strGivenName = arrCurrUserInfo(1)
             strSurname = arrCurrUserInfo(2)
             strAlias = arrCurrUserInfo(0)
             strCompany = arrCurrUserInfo(3)
             strDepartment = arrCurrUserInfo(4)
             strTelephone = arrCurrUserInfo(5)
             strExchServerName = arrCurrUserInfo(6)
             strStorageGroup = arrCurrUserInfo(7)
             strMailboxStore = arrCurrUserInfo(8)
             strTrustedDomain = arrCurrUserInfo(9)
             strEmail = arrCurrUserInfo(10)
             'strPassword = arrCurrUserInfo(11)
                   
             strExternalAccount = strTrustedDomain & "\" & strAlias
     
             fileout.writeline "Beginning creation of " & strGivenName & " " & strSurname
     
                  ' Verify that the specified mailbox store exists.
                  ' Initialize bFound.
                  bFound = False
                 
                  ' Get the default naming context.
                  Set iAdRootDSE = GetObject("LDAP://RootDSE")
                  strDomainDN = iAdRootDSE.Get("defaultNamingContext")
                 
                  ' Create objects for verifying existance of
                  ' the mailbox store where the mailbox will be created.
                  Set objServer = CreateObject("CDOEXM.ExchangeServer")
                  Set objSG = CreateObject("CDOEXM.StorageGroup")
                  Set objMSDB = CreateObject("CDOEXM.MailboxStoreDB")
                  Set iDS = objServer.GetInterface("IDataSource")
                 
                  ' Bind to the Exchange server.
                  iDS.Open strExchServerName
                 
                  ' Check that the destination mailbox store exists.
                  For Each storegroup In objServer.StorageGroups
WScript.Echo "Attempting to open Storaget Group: " & storegroup & " on server: " & strExchServerName

                     objSG.DataSource.Open storegroup
                 
                        ' Error handling.  If CDOEXM attempts to open a Recovery
                        ' Storage Group, a 0xC1032221 error will be returned.
                     If Err.Number <> 0 Then
                         fileout.writeline "An error occurred opening the specified storage group."
                         fileout.writeline "Error: 0x" & Hex(Err.Number) & " " & Err.Description
           
                         ' Clean up.
                         Set objSG = Nothing
                         
                         Exit For

                      End If
                 
                     If UCase(strStorageGroup) = UCase(objSG.Name) Then
                        For Each mbx In objSG.MailboxStoreDBs
                            objMSDB.DataSource.Open mbx
                            If UCase(strMailboxStore) = UCase(objMSDB.Name) Then
                                bFound = True
                                ' Get the LDAP URL for the mailbox store.
                                strLDAPUrl = "LDAP://" + mbx
                                Exit For
                            End If
                        Next
                     End If
                 
                     If bFound Then Exit For
                  Next
                 
                  ' Clean up.
                  Set objServer = Nothing
                  Set objSG = Nothing
                  Set objMSDB = Nothing
           
                  ' If the mailbox store was not found, exit the program.
                  If bFound = False Then
                      fileout.writeline "The specified mailbox store could not be found."
                  End If
     
                ' Validate the given and surnames.
                If ValidateName(strGivenName) = False Or ValidateName(strSurname) = False Then
                       bContinue = False
                End If
     
                ' Validate the e-mail alias.
                If ValidateAlias(strAlias) = False Then
                     bContinue = False
                End If

       Else
            fileout.writeline "The input line for user n° " & iLineNum + 1 & " has an incorrect syntax"
            bContinue = False
       End If

       ' ##################################################################################
        ' If input validation passed, then attempt to create the user object.
       If bContinue Then

          bContinue = CreateNewUser(strDCServerName, strGivenName, strSurname, strAlias, _
                                 strPassword, strCompany, strDepartment, strTelephone, objUser, strDomainDN)
       End If


       ' ##################################################################################      
       ' If the user object was successfully created, then attempt to create the mailbox.
     
     ' wait 1 second before creating the mailbox
    wscript.sleep(1000)
   
    If bContinue Then

              ' Initialize the variables.
        TimeInterval = 5000
        NumofTry = 120
        iCounter = 0

              ' Depending on the size of the network, the Recipient Update
              ' Service may take some time to propagate the new user
              ' to the Exchange server.  Attempt to create the mailbox every
              ' 5 seconds for 10 minutes.
        Do While iCounter < NumofTry

                        ' Attempt to create the mailbox in the specified
                        ' mailbox store.
            bContinue = CreateNewUserMailbox(objUser, strLDAPUrl)

            ' Continue if CreateNewUserMailbox succeeded.
            If bContinue Then Exit Do
            iCounter = iCounter + 1

            ' Wait before trying again.
            wscript.sleep(TimeInterval)
        Loop

              ' Could not create the mailbox after NumofTry attempts.
        If iCounter >= NumofTry Then
            bContinue = False
        End If
    End If


       ' ##################################################################################
       ' If the mailbox was created, then attempt to force the Exchange server to create the mailbox folders.
       ' First check if the mailbox folder needs to be created, because it can take a while
       ' for each account because of replication latency
       
       If CreateMailboxFolder = True then
          If bContinue Then
     
              ' Initialize the variables.
              TimeInterval = 5000
              NumofTry = 120
              iCounter = 0
     
                    ' Directory Service replication may take some time.  Attempt
                    ' to force the Exchange server to create the mailbox folders
                    ' every 5 seconds for 10 minutes.
              Do While iCounter < NumofTry
                  ' Wait for a certain time interval before trying again.
                  wscript.sleep(TimeInterval)
     
                  ' Attempt to force the Exchange server to create the
                              ' mailbox folders in the specified language..
                  If CreateMailboxFolders(strExchServerName, strDomainDN, strAlias, _
                                          strPassword, strFolderLang) Then Exit Do
                  iCounter = iCounter + 1
              Loop
     
                    ' Could not create the mailbox folders after NumofTry attempts.
              If iCounter >= NumofTry Then
                  fileout.writeline "... Failed to create the mailbox folders for " & strGivenName & " " & strSurname & " before logon."
              End If
          End If
    End If
   
             
       ' ##################################################################################
       ' If the mailbox was created, then attempt to change the ACL on the User objecct
      If bContinue Then
         
          bContinue = Add_ACE_ADUser(strSurName & " " & strGivenName & " " & strAlias)    
         
      End If
   

       ' ##################################################################################
       ' If the User object ACL list was changed, then attempt to change
       ' the ACL on the Mailbox objecct
    If bContinue Then
   
          bContinue = Add_ACE_Mailbox(strSurName & " " & strGivenName & " " & strAlias)    
   
    End If
   

       fileout.writeline("")

Next

' Close the file.
tsNewUsers.Close

' Clean up.
Set fs = Nothing
Set tsNewUsers = Nothing

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

MsgBox("Done")

' Exit the application.
wscript.Quit


'//////////////////////////////////////////////////////////////////////////////////
'// Function:  CreateNewUser
'//
'// Purpose:   Creates a new user in Active Directory with the specified given name,
'//            surname, e-mail alias, and password.
'//
'//
'// Input:     strDCServerName  = The domain controller on which the user
'//                               object will be created.
'//
'//            strGivenName     = The given name of the new user.
'//
'//            strSurname       =  The surname of the new user.
'//
'//            strAlias         = The e-mail alias of the new user.
'//
'//            strPassword      = The password for the new user.
'//
'//            strCompany           = The company for the new user.
'//
'//            strDepartment    = The department for the new user.
'//
'//            strTelephone     = The telephone for the new user.
'//
'//  Output:   objUser          = The user object for the new user.
'//
'//            strDomainDN      = The domain DN of the new user.
'//
'// Returns:   True if AD user object is created, False if it isn't.
'/////////////////////////////////////////////////////////////////////////////////
Function CreateNewUser(strDCServerName, strGivenName, strSurname, strAlias, _
                       strPassword, strCompany, strDepartment, strTelephone, objUser, strDomainDN)

    On Error Resume Next
On Error GoTo 0
    CreateNewUser = False

    ' Declare program variables.
    Dim objContainer     'As IADsContainer
    Dim strRecip         'As String

   ' Build the recipient string.
    strRecip = "CN=" & strSurName & " " & strGivenName & " " & strAlias

  'Get the container.
    WScript.Echo "Attempting to connect to: " & "LDAP://" & strDCServerName & "/" & strOU & "," & strDomainDN
    Set objContainer = GetObject("LDAP://" & strDCServerName & "/" & strOU & "," & strDomainDN)



    '  Get the container.
    'Set objContainer = GetObject("LDAP://" & strDCServerName & "/" & strOU & "," & strDomainDN)
    ' Initialize the user object.
Set objUser = objContainer.Create("User", strRecip)

    ' Set the display name, account name, given name, surname, an
    ' and userprinciple properties of the user object.
    objUser.Put "displayname", strSurname & ", " & strGivenName
    objUser.Put "sAMAccountName", strAlias
    objUser.Put "givenName", strGivenName
    objUser.Put "sn", strSurname
    objUser.Put "company", strCompany
    objUser.Put "department", strDepartment
    objUser.Put "telephoneNumber", strTelephone
    objUser.Put "userPrincipalName", strAlias
    objUser.Put "mail", strEmail
   

       ' Save the changes to the user object.
    objUser.SetInfo
   
    ' Error handling.
    If Err.Number <> 0 Then
        fileout.writeline "... Error creating user object"
        fileout.writeline "... Error: " & Err.Number & " " & Err.Description

        ' Clean up.
        Set objContainer = Nothing
        Set objServer = Nothing
        Set objSG = Nothing
        Set objMSDB = Nothing

        If Err.Number = -2147019886 Then
            fileout.writeline "... The object already exists."
            CreateNewUser = False
            Exit Function
        End If

        CreateNewUser = False
        Exit Function
    End If

    ' Set the password for the new user.  This should be changed by the user
    ' after he or she logs on.
    objUser.SetPassword strPassword

    ' Enable the new user account.
    'objUser.AccountDisabled = False

    ' Clean up.
    Set objContainer = Nothing
    Set objServer = Nothing
    Set objSG = Nothing
    Set objMSDB = Nothing

       fileout.writeline "... Succesfully created user."

    CreateNewUser = True
End Function


'//////////////////////////////////////////////////////////////////////////////////
'// Function:  CreateNewUserMailbox
'//
'// Purpose:   Creates a mailbox for the new user in the specified
'//            mailbox store.
'//
'//
'// Input:     objUser    = The user object for the new user.
'//
'//            strLDAPUrl = The LDAP URL for the new user.
'//
'// Returns:   True if the mailbox is created, False if it isn't.
'/////////////////////////////////////////////////////////////////////////////////
Function CreateNewUserMailbox(objUser, strLDAPUrl)
    On Error Resume Next

    CreateNewUserMailbox = False

       ' Variables
    Dim objMailbox       'As CDOEXM.IMailboxStore

    ' Get the IMailboxStore interface.
    Set objMailbox = objUser

    ' Create a mailbox for the recipient on the specified Exchange server.
    objMailbox.CreateMailbox strLDAPUrl

    'Enable immediate-logon for the user.
    objUser.Put "msExchUserAccountControl", 2

     
    ' Save changes to the user object.
    objUser.SetInfo

    ' Error handling.
    If Err.Number <> 0 Then
        fileout.writeline "... Error creating mailbox."
        fileout.writeline "... Error: " & Err.Number & " " & Err.Description

        ' Clean up.
        Set objUser = Nothing
        Set objMailbox = Nothing

        CreateNewUserMailbox = False

        Exit Function
    End If

    ' Clean up.
    Set objUser = Nothing
    Set objMailbox = Nothing

    fileout.writeline "... Succesfully created mailbox."
    CreateNewUserMailbox = True
End Function


'//////////////////////////////////////////////////////////////////////////////////
'// Function:  CreateMailboxFolders
'//
'// Purpose:   Forces the specified Exchange server to create the user's mailbox
'//            folders if they don't already exist.
'//
'// Input:     strExchServerName = The Exchange server on which the mailbox
'//                            has been created.
'//
'//            strDomainDN   = The domain DN of the new user.
'//
'//            strAlias      = The e-mail alias of the new user.
'//
'//            strPassword   = The password for the new user.
'//
'//            strFolderLang = The language in which the mailbox
'//                            folders will be created.
'//
'/////////////////////////////////////////////////////////////////////////////////
Function CreateMailboxFolders(strExchServerName, strDomainDN, strAlias,  _
                                  strPassword, strFolderLang)
    On Error Resume Next

    CreateMailboxFolders = False

       ' Variables
    Dim strMailboxURL    'As String
      Dim strUserDomain    'As String

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

    ' Build the Domain\Username string.
    strUserDomain = Left(strDomainDN, InStr(1, strDomainDN, ",", vbTextCompare) - 1)
    strUserDomain = Right(strUserDomain, Len(strUserDomain) - 3) + "\" + strAlias

       ' Create the XMLHTTP object.
    Dim oXMLHTTP
    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", strFolderLang
    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
        fileout.writeline "... Mailbox folders successfully created."
        CreateMailboxFolders = True
    Else
        'GET method did not successfully force creation of mailbox folders.
        CreateMailboxFolders = False
    End If

       Set oXMLHTTP = Nothing
End Function

'//////////////////////////////////////////////////////////////////////////////////
'// Function:  ValidateInput
'//
'// Purpose:   Verifies that the specified server, mailbox store, or storage group name
'//            is not longer than 64 characters and doesn't contain any illegal characters.
'//
'// Input:     sInput    = The specified server, mailbox store, or storage group name.
'//
'// Returns:   True if the string is validated, False if it isn't.
'/////////////////////////////////////////////////////////////////////////////////
Function ValidateInput(sInput)
    ValidateInput = False

       Dim strPattern  'As String
       Dim regex               'As RegExp

       If Len(sInput) > 64 Then
        fileout.writeline "The length of the specified server, mailbox store, or storage group name" _
                     + " cannot exceed 64 characters."
        Exit Function
    End If

       ' Create the regular expression object.
       Set regex = New RegExp

       ' Set the pattern to search for.
       strPattern = ";|/|\\"
       regex.Pattern = strPattern
       regex.Global = True

    ' Exit the application if ';', '\', or '/'
       ' is found in the input string.
       If regex.Test(sInput) Then
          fileout.writeline "The specified server, mailbox store, or storage group name cannot contain ';', '\', or '/'."

          ' Clean up.
          Set regex = Nothing

          ' Exit the application.
             Exit Function
       End If

       ' Clean up.
       Set regex = Nothing

    ValidateInput = True
End Function

'//////////////////////////////////////////////////////////////////////////////////
'// Function:  ValidateAlias
'//
'// Purpose:   Verifies that the specified e-mail alias is not longer than 256
'//            characters, doesn't contain any illegal characters.
'//
'// Input:     sInput = The specified e-mail alias.
'//
'// Returns:   True if the string is validated, False if it isn't.
'/////////////////////////////////////////////////////////////////////////////////

Function ValidateAlias(sInput)
    ValidateAlias = False

       Dim strPattern  'As String
       Dim regex               'As RegExp

    If Len(sInput) > 256 Then
        fileout.writeline "The length of the e-mail alias cannot exceed 256 characters."
        Exit Function
    End If

       ' Create the regular expression object.
       Set regex = New RegExp

       ' Set the pattern to search for.
       strPattern = ":|\*|;|<|>|\||\"""
       regex.Pattern = strPattern
       regex.Global = True

       ' Exit the application if ';', '\', or '/'
       ' is found in the input string.
    If regex.Test(sInput) Then
          fileout.writeline "The specified server, mailbox store, or storage group name cannot contain ':', '*', " & _
                          " '|', ';', '<', '>', or '""'."

          ' Clean up.
          Set regex = Nothing

          ' Exit the application.
             Exit Function
       End If

       ' Clean up.
       Set regex = Nothing

    ValidateAlias = True
End Function

'//////////////////////////////////////////////////////////////////////////////////
'// Function:  ValidateName
'//
'// Purpose:   Verifies that the specified name is not longer than 28
'//            characters and doesn't contain the '<script' tag.
'//
'// Input:     sInput = The specified name.
'//
'// Returns:   True if the string is validated, False if it isn't.
'/////////////////////////////////////////////////////////////////////////////////

Function ValidateName(sInput)
    ValidateName = False

       Dim strPattern  'As String
       Dim regex               'As RegExp

    If Len(sInput) > 28 Then
        fileout.writeline "The length of the name cannot exceed 28 characters."
        Exit Function
    End If

       ' Create the regular expression object.
       Set regex = New RegExp

       ' Set the pattern to search for.
       strPattern = "<script"
       regex.Pattern = strPattern
       regex.Global = True

       ' Exit the application if "<script"
       ' is found in the input string.
    If regex.Test(sInput) Then
          fileout.writeline "The specified name cannot contain '<script'."

          ' Clean up.
          Set regex = Nothing

          ' Exit the application.
             Exit Function
       End If

       ' Clean up.
       Set regex = Nothing

    ValidateName = True
End Function


'//////////////////////////////////////////////////////////////////////////////////
'// 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
     
      Add_ACE_ADUser = False
     
      Set oUser = GetObject ("LDAP://cn=" & strADUser & "," & strOU & "," & strDomainDN)
      Set oSecurityDescriptor = oUser.Get("ntSecurityDescriptor")
     
      Err.Clear
     
      ' Extract the Discretionary Access Control List (DACL) using the IADsSecurityDescriptor.
      ' Interface.
      Set dacl = oSecurityDescriptor.DiscretionaryAcl
      Set ace = CreateObject("AccessControlEntry")
     
      ' Template: AddAce(TrusteeName, gAccessMask, gAceType, gAceFlags, gFlags, gObjectType, gInheritedObjectType)
       AddAce dacl,strExternalAccount,&H20014,0,0,1,0,0      '&H20014 -> gives Read permissions
       AddAce dacl,strExternalAccount,&H100,5,0,1,"{AB721A54-1E2F-11D0-9819-00AA0040529B}",0      '&H100 & the string -> enables the Send As permissions
     
       ' Add the modified DACL to the security descriptor.
       oSecurityDescriptor.DiscretionaryAcl = dacl
     
       ' Save new SD onto the user.
       oUser.Put "ntSecurityDescriptor",Array(oSecurityDescriptor)
     
       ' Commit changes from the property cache to the information store.
       oUser.SetInfo
       
       If Err.Number <> 0 Then
             fileout.writeline "... Failed to give the 'Read' & 'Send As' 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
       
       fileout.writeline "... Succesfully added the 'Read' & 'Send As' permissions to the account."
       
       '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
     
      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,131079,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
Hi Rob Hope you had a great weekend.

Here is the final code that chandru had edited to reduce the size...
Able to create a user and mailbox with a comma delimiter.
Need to expand this a bit.

'Create script
Option Explicit

'On Error Resume Next
On Error GoTo 0

' Declare variables for input parameters.
Dim strDCServerName              ' As String
Dim strExchServerName            ' As String
Dim strStorageGroup              ' As String
Dim strMailboxStore              ' As String
Dim strUserFileName              ' As String
Dim strGivenName                 ' As String
Dim strSurname                   ' As String
Dim strAlias                     ' As String
Dim strPassword                  ' As String
Dim strCompany                   ' As String
Dim strDepartment                ' As String
Dim strTelephone                 ' As String
Dim stremail                     ' As String
Dim bIsFound                     ' As Boolean
Dim i                            ' As Integer
Dim vProxyAddresses              ' As Array
Dim nProxyAddresses              ' As Array
Dim strFolderLang                ' As String
Dim strExternalAccount           ' As String
Dim strTrustedDomain             ' As String
Dim strLogFile                   ' As String

' Declare variables used for verifying the existance of the mailbox store
' where the mailbox is to be created.
Dim iDS                         ' As IDataSource
Dim iAdRootDSE                  ' As ActiveDs.IADs
Dim objServer                   ' CDOEXM.ExchangeServer
Dim objSG                       ' CDOEXM.StorageGroup
Dim objMSDB                     ' CDOEXM.MailboxStoreDB
Dim storegroup                  ' CDOEXM.MailboxStoreDB
Dim mbx                         ' CDOEXM.MailboxStoreDB
Dim bFound                      ' As Boolean
Dim CreateMailboxFolder         ' As Boolean

' Declare variables for iterating through the
' file of new users.
Dim objUser                     ' As IADsUser
Dim strDomainDN                 ' As String
Dim strLDAPUrl                  ' As String
Dim strOU                       ' As String
Dim arrNewUsersInfo             ' As Array
Dim strCurrUserInfo             ' As String
Dim arrCurrUserInfo             ' As Array
Dim fs                          ' As FileSystemObject
Dim filein                      ' As As fs.TextStream
Dim fileout                     ' As As fs.TextStream
Dim tsNewUsers                  ' As FSO.TextStream
Dim iLineNum                    ' As Integer
Dim bContinue                   ' As Boolean
Dim TimeInterval                ' As Integer
Dim NumofTry                    ' As Integer
Dim iCounter                    ' As Integer

' Get input parameters.
strDCServerName = "indc01"
strOU = "OU=Named Accounts,OU=User Accounts,OU=IND,OU=Countries"
strUserFileName = "NewUsers.csv"
strPassword = "abc123"
strLogFile = "Created_Users_and_Mailboxes.txt"
strFolderLang = "en-us"
CreateMailboxFolder = True

'Open the New_users filename to read in all contacts
Err.Clear
Set fs = CreateObject("Scripting.FileSystemObject")
Set fileout= fs.OpenTextFile(strlogfile,8,True)
If fs.fileexists(strUserFileName) Then
      Set filein = fs.OpenTextFile(strUserFileName, 1)
Else
      fileout.writeline:fileout.writeline("!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!")
      fileout.writeline
      fileout.writeline("Error reported on " & Now)
      fileout.writeline("Problem opening the New_users file. Make sure the " & strUserFileName & " file exists!")
      fileout.writeline
      fileout.writeline("!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!")
      WScript.Quit
End If

fileout.writeline:fileout.writeline("*************************************************************************************")
fileout.writeline("Beginning creation of new users and mailboxes on " & Now)
fileout.writeline

' Open the new users file.
Set tsNewUsers = fs.OpenTextFile(strUserFileName, 1, -1)

' Error handling.
If Err <> 0 Then
    fileout.writeline "An error occurred opening the file of new users."
    fileout.writeline "Error: " & Err.Number & " " & Err.Description
    fileout.writeline "Exiting the application."

    ' Clean up.
    Set fs = Nothing
    Set tsNewUsers = Nothing
    wscript.Quit
End If

' Get all lines from the new users file and split
' them into an array of strings.
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), ",", -1, 1)

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

               ' Get the given name, surname, e-mail alias, and password from the array.
             strGivenName = arrCurrUserInfo(1)
'Wscript.echo strGivenName
             strSurname = arrCurrUserInfo(2)
'Wscript.echo strSurname
             strAlias = arrCurrUserInfo(0)
'Wscript.echo strAlias
             strCompany = arrCurrUserInfo(3)
'Wscript.echo strCompany
             strDepartment = arrCurrUserInfo(4)
'Wscript.echo strDepartment
             strTelephone = arrCurrUserInfo(5)
'Wscript.echo strTelephone
             strExchServerName = arrCurrUserInfo(6)
'Wscript.echo strExchServerName
             strStorageGroup = arrCurrUserInfo(7)
'Wscript.echo strStorageGroup
             strMailboxStore = arrCurrUserInfo(8)
'Wscript.echo strMailboxStore
             strTrustedDomain = arrCurrUserInfo(9)
'Wscript.echo strTrustedDomain
             strEmail = arrCurrUserInfo(10)
'Wscript.echo strEmail
             'strPassword = arrCurrUserInfo(11)
                   
             strExternalAccount = strTrustedDomain & "\" & strAlias
     
             fileout.writeline "Beginning creation of " & strGivenName & " " & strSurname
     
                  ' Verify that the specified mailbox store exists.
                  ' Initialize bFound.
                  bFound = False
                 
                  ' Get the default naming context.
                  Set iAdRootDSE = GetObject("LDAP://RootDSE")
                  strDomainDN = iAdRootDSE.Get("defaultNamingContext")
                 
                  ' Create objects for verifying existance of
                  ' the mailbox store where the mailbox will be created.
                  Set objServer = CreateObject("CDOEXM.ExchangeServer")
                  Set objSG = CreateObject("CDOEXM.StorageGroup")
                  Set objMSDB = CreateObject("CDOEXM.MailboxStoreDB")
                  Set iDS = objServer.GetInterface("IDataSource")
                 
                  ' Bind to the Exchange server.
                  iDS.Open strExchServerName
                 
                  ' Check that the destination mailbox store exists.
                  For Each storegroup In objServer.StorageGroups
'WScript.Echo "Attempting to open Storaget Group: " & storegroup & " on server: " & strExchServerName

                     objSG.DataSource.Open storegroup
                 
                        ' Error handling.  If CDOEXM attempts to open a Recovery
                        ' Storage Group, a 0xC1032221 error will be returned.
                     If Err.Number <> 0 Then
                         fileout.writeline "An error occurred opening the specified storage group."
                         fileout.writeline "Error: 0x" & Hex(Err.Number) & " " & Err.Description
           
                         ' Clean up.
                         Set objSG = Nothing
                         
                         Exit For

                      End If
                 
                     If UCase(strStorageGroup) = UCase(objSG.Name) Then
                        For Each mbx In objSG.MailboxStoreDBs
                            objMSDB.DataSource.Open mbx
                            If UCase(strMailboxStore) = UCase(objMSDB.Name) Then
                                bFound = True
                                ' Get the LDAP URL for the mailbox store.
                                strLDAPUrl = "LDAP://" + mbx
                                Exit For
                            End If
                        Next
                     End If
                 
                     If bFound Then Exit For
                  Next
                 
                  ' Clean up.
                  Set objServer = Nothing
                  Set objSG = Nothing
                  Set objMSDB = Nothing
           
                  ' If the mailbox store was not found, exit the program.
                  If bFound = False Then
                      fileout.writeline "The specified mailbox store could not be found."
                  End If
     
                ' Validate the given and surnames.
                If ValidateName(strGivenName) = False Or ValidateName(strSurname) = False Then
                       bContinue = False
                End If
     
                ' Validate the e-mail alias.
                If ValidateAlias(strAlias) = False Then
                     bContinue = False
                End If

       Else
            fileout.writeline "The input line for user n° " & iLineNum + 1 & " has an incorrect syntax"
            bContinue = False
       End If

       ' ##################################################################################
        ' If input validation passed, then attempt to create the user object.
       If bContinue Then

          bContinue = CreateNewUser(strDCServerName, strGivenName, strSurname, strAlias, _
                                 strPassword, strCompany, strDepartment, strTelephone, objUser, strDomainDN)
       End If


       ' ##################################################################################      
       ' If the user object was successfully created, then attempt to create the mailbox.
     
     ' wait 1 second before creating the mailbox
    wscript.sleep(1000)
   
    If bContinue Then

              ' Initialize the variables.
        TimeInterval = 5000
        NumofTry = 120
        iCounter = 0

              ' Depending on the size of the network, the Recipient Update
              ' Service may take some time to propagate the new user
              ' to the Exchange server.  Attempt to create the mailbox every
              ' 5 seconds for 10 minutes.
        Do While iCounter < NumofTry

                        ' Attempt to create the mailbox in the specified
                        ' mailbox store.
            bContinue = CreateNewUserMailbox(objUser, strLDAPUrl)

            ' Continue if CreateNewUserMailbox succeeded.
            If bContinue Then Exit Do
            iCounter = iCounter + 1

            ' Wait before trying again.
            wscript.sleep(TimeInterval)
        Loop

              ' Could not create the mailbox after NumofTry attempts.
        If iCounter >= NumofTry Then
            bContinue = False
        End If
    End If


       ' ##################################################################################
       ' If the mailbox was created, then attempt to force the Exchange server to create the mailbox folders.
       ' First check if the mailbox folder needs to be created, because it can take a while
       ' for each account because of replication latency
       
        If CreateMailboxFolder = True then
          If bContinue Then
     
              ' Initialize the variables.
              TimeInterval = 60000
              NumofTry = 10
              iCounter = 0

     
                    ' Directory Service replication may take some time.  Attempt
                    ' to force the Exchange server to create the mailbox folders
                    ' every 5 seconds for 10 minutes.
              Do While iCounter < NumofTry
                  ' Wait for a certain time interval before trying again.
                  wscript.sleep(TimeInterval)
     
                  ' Attempt to force the Exchange server to create the
                              ' mailbox folders in the specified language..
                  If CreateMailboxFolders(strExchServerName, strDomainDN, strAlias, _
                                          strPassword, strFolderLang) Then Exit Do
                  iCounter = iCounter + 1
              Loop
     
                    ' Could not create the mailbox folders after NumofTry attempts.
              If iCounter >= NumofTry Then
                  fileout.writeline "... Failed to create the mailbox folders for " & strGivenName & " " & strSurname & " before logon."
              End If
          End If
    End If

       fileout.writeline("")

Next

' Close the file.
tsNewUsers.Close

' Clean up.
Set fs = Nothing
Set tsNewUsers = Nothing

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

MsgBox("Done")

' Exit the application.
wscript.Quit


'//////////////////////////////////////////////////////////////////////////////////
'// Function:  CreateNewUser
'//
'// Purpose:   Creates a new user in Active Directory with the specified given name,
'//            surname, e-mail alias, and password.
'//
'//
'// Input:     strDCServerName  = The domain controller on which the user
'//                               object will be created.
'//
'//            strGivenName     = The given name of the new user.
'//
'//            strSurname       =  The surname of the new user.
'//
'//            strAlias         = The e-mail alias of the new user.
'//
'//            strPassword      = The password for the new user.
'//
'//            strCompany           = The company for the new user.
'//
'//            strDepartment    = The department for the new user.
'//
'//            strTelephone     = The telephone for the new user.
'//
'//  Output:   objUser          = The user object for the new user.
'//
'//            strDomainDN      = The domain DN of the new user.
'//
'// Returns:   True if AD user object is created, False if it isn't.
'/////////////////////////////////////////////////////////////////////////////////
Function CreateNewUser(strDCServerName, strGivenName, strSurname, strAlias, _
                       strPassword, strCompany, strDepartment, strTelephone, objUser, strDomainDN)

    On Error Resume Next
On Error GoTo 0
    CreateNewUser = False

    ' Declare program variables.
    Dim objContainer     'As IADsContainer
    Dim strRecip         'As String

   ' Build the recipient string.
    strRecip = "CN=" & strSurName & " " & strGivenName & " " & strAlias

  'Get the container.
'    WScript.Echo "Attempting to connect to: " & "LDAP://" & strDCServerName & "/" & strOU & "," & strDomainDN
    Set objContainer = GetObject("LDAP://" & strDCServerName & "/" & strOU & "," & strDomainDN)



    '  Get the container.
    'Set objContainer = GetObject("LDAP://" & strDCServerName & "/" & strOU & "," & strDomainDN)
    ' Initialize the user object.
Set objUser = objContainer.Create("User", strRecip)

    ' Set the display name, account name, given name, surname, an
    ' and userprinciple properties of the user object.
    objUser.Put "displayname", strSurname & ", " & strGivenName
    objUser.Put "sAMAccountName", strAlias
    objUser.Put "givenName", strGivenName
    objUser.Put "sn", strSurname
    objUser.Put "company", strCompany
    objUser.Put "department", strDepartment
    objUser.Put "telephoneNumber", strTelephone
    objUser.Put "userPrincipalName", strAlias
    objUser.Put "mail", strEmail
   

       ' Save the changes to the user object.
    objUser.SetInfo
   
    ' Error handling.
    If Err.Number <> 0 Then
        fileout.writeline "... Error creating user object"
        fileout.writeline "... Error: " & Err.Number & " " & Err.Description

        ' Clean up.
        Set objContainer = Nothing
        Set objServer = Nothing
        Set objSG = Nothing
        Set objMSDB = Nothing

        If Err.Number = -2147019886 Then
            fileout.writeline "... The object already exists."
            CreateNewUser = False
            Exit Function
        End If

        CreateNewUser = False
        Exit Function
    End If

    ' Set the password for the new user.  This should be changed by the user
    ' after he or she logs on.
    objUser.SetPassword strPassword

    ' Enable the new user account.
        objUser.AccountDisabled = False

    ' Clean up.
    Set objContainer = Nothing
    Set objServer = Nothing
    Set objSG = Nothing
    Set objMSDB = Nothing

       fileout.writeline "... Succesfully created user."

    CreateNewUser = True
End Function


'//////////////////////////////////////////////////////////////////////////////////
'// Function:  CreateNewUserMailbox
'//
'// Purpose:   Creates a mailbox for the new user in the specified
'//            mailbox store.
'//
'//
'// Input:     objUser    = The user object for the new user.
'//
'//            strLDAPUrl = The LDAP URL for the new user.
'//
'// Returns:   True if the mailbox is created, False if it isn't.
'/////////////////////////////////////////////////////////////////////////////////
Function CreateNewUserMailbox(objUser, strLDAPUrl)
    On Error Resume Next

    CreateNewUserMailbox = False

       ' Variables
    Dim objMailbox       'As CDOEXM.IMailboxStore

    ' Get the IMailboxStore interface.
    Set objMailbox = objUser

    ' Create a mailbox for the recipient on the specified Exchange server.
    objMailbox.CreateMailbox strLDAPUrl

    'Enable immediate-logon for the user.
    objUser.Put "msExchUserAccountControl", 2

     
    ' Save changes to the user object.
    objUser.SetInfo

    ' Error handling.
    If Err.Number <> 0 Then
        fileout.writeline "... Error creating mailbox."
        fileout.writeline "... Error: " & Err.Number & " " & Err.Description

        ' Clean up.
        Set objUser = Nothing
        Set objMailbox = Nothing

        CreateNewUserMailbox = False

        Exit Function
    End If

    ' Clean up.
    Set objUser = Nothing
    Set objMailbox = Nothing

    fileout.writeline "... Succesfully created mailbox."
    CreateNewUserMailbox = True
End Function


'//////////////////////////////////////////////////////////////////////////////////
'// Function:  CreateMailboxFolders
'//
'// Purpose:   Forces the specified Exchange server to create the user's mailbox
'//            folders if they don't already exist.
'//
'// Input:     strExchServerName = The Exchange server on which the mailbox
'//                            has been created.
'//
'//            strDomainDN   = The domain DN of the new user.
'//
'//            strAlias      = The e-mail alias of the new user.
'//
'//            strPassword   = The password for the new user.
'//
'//            strFolderLang = The language in which the mailbox
'//                            folders will be created.
'//
'/////////////////////////////////////////////////////////////////////////////////
Function CreateMailboxFolders(strExchServerName, strDomainDN, strAlias,  _
                                  strPassword, strFolderLang)
    On Error Resume Next

    CreateMailboxFolders = False

       ' Variables
    Dim strMailboxURL    'As String
      Dim strUserDomain    'As String

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

    ' Build the Domain\Username string.
    strUserDomain = Left(strDomainDN, InStr(1, strDomainDN, ",", vbTextCompare) - 1)
    strUserDomain = Right(strUserDomain, Len(strUserDomain) - 3) + "\" + strAlias

       ' Create the XMLHTTP object.
    Dim oXMLHTTP
    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", strFolderLang
    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
        fileout.writeline "... Mailbox folders successfully created."
        CreateMailboxFolders = True
    Else
        'GET method did not successfully force creation of mailbox folders.
        CreateMailboxFolders = False
    End If

       Set oXMLHTTP = Nothing
End Function

'//////////////////////////////////////////////////////////////////////////////////
'// Function:  ValidateInput
'//
'// Purpose:   Verifies that the specified server, mailbox store, or storage group name
'//            is not longer than 64 characters and doesn't contain any illegal characters.
'//
'// Input:     sInput    = The specified server, mailbox store, or storage group name.
'//
'// Returns:   True if the string is validated, False if it isn't.
'/////////////////////////////////////////////////////////////////////////////////
Function ValidateInput(sInput)
    ValidateInput = False

       Dim strPattern  'As String
       Dim regex               'As RegExp

       If Len(sInput) > 64 Then
        fileout.writeline "The length of the specified server, mailbox store, or storage group name" _
                     + " cannot exceed 64 characters."
        Exit Function
    End If

       ' Create the regular expression object.
       Set regex = New RegExp

       ' Set the pattern to search for.
       strPattern = ";|/|\\"
       regex.Pattern = strPattern
       regex.Global = True

    ' Exit the application if ';', '\', or '/'
       ' is found in the input string.
       If regex.Test(sInput) Then
          fileout.writeline "The specified server, mailbox store, or storage group name cannot contain ';', '\', or '/'."

          ' Clean up.
          Set regex = Nothing

          ' Exit the application.
             Exit Function
       End If

       ' Clean up.
       Set regex = Nothing

    ValidateInput = True
End Function

'//////////////////////////////////////////////////////////////////////////////////
'// Function:  ValidateAlias
'//
'// Purpose:   Verifies that the specified e-mail alias is not longer than 256
'//            characters, doesn't contain any illegal characters.
'//
'// Input:     sInput = The specified e-mail alias.
'//
'// Returns:   True if the string is validated, False if it isn't.
'/////////////////////////////////////////////////////////////////////////////////

Function ValidateAlias(sInput)
    ValidateAlias = False

       Dim strPattern  'As String
       Dim regex               'As RegExp

    If Len(sInput) > 256 Then
        fileout.writeline "The length of the e-mail alias cannot exceed 256 characters."
        Exit Function
    End If

       ' Create the regular expression object.
       Set regex = New RegExp

       ' Set the pattern to search for.
       strPattern = ":|\*|;|<|>|\||\"""
       regex.Pattern = strPattern
       regex.Global = True

       ' Exit the application if ';', '\', or '/'
       ' is found in the input string.
    If regex.Test(sInput) Then
          fileout.writeline "The specified server, mailbox store, or storage group name cannot contain ':', '*', " & _
                          " '|', ';', '<', '>', or '""'."

          ' Clean up.
          Set regex = Nothing

          ' Exit the application.
             Exit Function
       End If

       ' Clean up.
       Set regex = Nothing

    ValidateAlias = True
End Function

'//////////////////////////////////////////////////////////////////////////////////
'// Function:  ValidateName
'//
'// Purpose:   Verifies that the specified name is not longer than 28
'//            characters and doesn't contain the '<script' tag.
'//
'// Input:     sInput = The specified name.
'//
'// Returns:   True if the string is validated, False if it isn't.
'/////////////////////////////////////////////////////////////////////////////////

Function ValidateName(sInput)
    ValidateName = False

       Dim strPattern  'As String
       Dim regex               'As RegExp

    If Len(sInput) > 28 Then
        fileout.writeline "The length of the name cannot exceed 28 characters."
        Exit Function
    End If

       ' Create the regular expression object.
       Set regex = New RegExp

       ' Set the pattern to search for.
       strPattern = "<script"
       regex.Pattern = strPattern
       regex.Global = True

       ' Exit the application if "<script"
       ' is found in the input string.
    If regex.Test(sInput) Then
          fileout.writeline "The specified name cannot contain '<script'."

          ' Clean up.
          Set regex = Nothing

          ' Exit the application.
             Exit Function
       End If

       ' Clean up.
       Set regex = Nothing

    ValidateName = True
End Function

Need to expand this.
The csv file should have a header.
need to add groups
need to add address,mobileno,office,title,designation etc.
ASKER CERTIFIED SOLUTION
Avatar of RobSampson
RobSampson
Flag of Australia image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Rob user created from the csv with the headers fine. But it takes more than 5 min to create a single user with the headers.For the Done button to come it takes so long.But the log file it shows "Sucessfully created user and mailbox in say 30 sec.And when i check the Ads the user is also showing there.

If you can intergrate the other details from the old question to this it would be great
Can you help on this...
Sharath,

I think it is taking time because of the mailbox folder creation. We can comment those line and you can test. The mailbox folder will be created automatically when the user logs in first time

regards
Chandru
Which are the line
Try changing this line as below

CreateMailboxFolder = False
ya now its fast...
Hi Rob and Chandru,

As disscussed ro i have raised a Q for get details from mails to excel...

https://www.experts-exchange.com/questions/22880459/Convert-these-mails-to-excel.html

Chandru can you also help please....
if you are happy with this we can work on the other part and when the user logs in for the first time the mailbox folders will be created

I think the post has reached more than 100 comments. Can you open a new question?

Rob - Hope you agree
Yes i am ok with it Chandru.
As mentioned by Rob the link
https://www.experts-exchange.com/questions/22804838/Need-to-create-users-in-ADS-from-the-excel-file.html
Already has the working of adding many more fields to the excel.So can you and Rob help in adding them to this script...
I think there we were stuck in adding the user to a "Root domain group"
Ok i can close the Q and raise a continuation Q Rob and Chandru please suggest whome the points needs to be given...:)
Thanks Sharath....

Yes we can work on getting both the script combined
Offcourse Rob............
Hey wow!  I go away go away for a couple of hours, then things have happened, and I need to catch up! LOL!

Thanks for the points, but splitting them probably would have been better.  Sharath, you can accept multiple answers to split the points between.....but it doesn't really matter anyway!

OK, I'll catch up on what's been happening....

Rob.
Ok Rob...The above lik will show you the new Question i have posted...