Start Free Trial

asked on

Need to create users in ADS from the excel file

Hi,

I have a excel file with these data in it.

Colum1 Colum2 Colum3 Colum4 Colum5 Colum6 Colum7
Full Name Ntlogin EmailId Managername Groups to be added Designation Department

Colum8
Description

Password has to be default for all users
Password never expires has to be set
All users should be created in a specific OU.
Colum1,2,3 must be compulsory others can be optional

Is there a script to get this done.
I need to create 400 users and i have this data ready in the excel.
Regards
Sharath

You could use CSVDE to import the Excel sheet in AD.
I don't know about the groups and the designation fields, but if you can skip these two fields and can add the distinguished name (e.g. CN=Sharath,OU=ICT,DC=yourdomain,dc=com) to the spreadsheet, it should work.

Use these row headers:
CN, sAMAccountName, mail, manager, department, DN

Save the file as Comma Seperated Values file (CSV). Open a command prompt on the server, go to the folder where the CSV file is and enter this command:

CSVDE -i -f yourfile.csv

I recommend you start with a small test spreadsheet. If that works, try the real spreadsheet.
If you want to add passwords to the accounts, please check this little article: http://www.computerperformance.co.uk/ezine/ezine23.htm

This site was of great help when I had to find out all these things.

take a look at
http://www.rlmueller.net/CreateUsers.htm
and
http://www.adminscripteditor.com/scriptlibrary/view.asp?id=557
and
http://www.shijaz.com/windows/csvde.htm

for examples of how to do this

Sharath, there's a few suggestions here too:
https://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q__22801025.html

Regards,

Rob.

ASKER

Rob this is what i wanted but can you change a bit to suit my Situation please....

Sharath, for the Full Name, how will you separate the First and Last name? They are separate fields in the AD. If you want ony the last "word" of the name to be the last name, and the rest the first name, I can do that.
Or, if, in the Full Name column, you have something like
Smith, John De
Then I can separate it by the comma.

Regards,

Rob.

ASKER

Rob...

I will have names like this
Sharath reddy
Sharath is the first name
reddy is the last name

Will the manager field contain a full name or a username (NT Login)?

Rob.

ASKER

Nt Login would be there

And the groups....will they be full group names, separated by a colon?

Rob.

ASKER

Yes groups seperated by Colon and the groups can be of the root Domain (Primary domain also)

Sharath, try this....please test it on only a few users to start with.....
The things to configure are at the top in this section:

' CONFIGURATION PARAMETERS FOR THE SCRIPT
strExcelFile = Replace(WScript.ScriptFullName, WScript.ScriptName, "") & "Users_Sharath.xls"
strOUPath = "ou=Users,ou=TestOU," & objRootLDAP.Get("defaultNamingContext")
strPassword = "defaultpassword"
' END CONFIGURATION PARAMETERS

'===================
' 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=Users,ou=TestOU," & objRootLDAP.Get("defaultNamingContext")
strPassword = "defaultpassword"
' 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)
      strDepartment = Trim(objExcel.ActiveSheet.Cells(intRow, "G").Value)
      strDescription = Trim(objExcel.ActiveSheet.Cells(intRow, "H").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=", "")
                  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 strDepartment <> "" Then objNewUser.Put "department", strDepartment
                  If strDescription <> "" Then objNewUser.Put "description", strDescription
                  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
                              Set objGroup = GetObject(Get_LDAP_User_Properties("group", "cn", strGroupName, "adsPath"))
                              On Error Resume Next
                              objGroup.Add objNewUser.AdsPath
                              On Error GoTo 0
                              Set objGroup = Nothing
                        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)
      ' Setup ADO objects.
      Set adoCommand = CreateObject("ADODB.Command")
      Set adoConnection = CreateObject("ADODB.Connection")
      adoConnection.Provider = "ADsDSOObject"
      adoConnection.Open "Active Directory Provider"
      adoCommand.ActiveConnection = adoConnection

      ' Search entire Active Directory domain.
      Set objRootDSE = GetObject("LDAP://RootDSE")
      strDNSDomain = objRootDSE.Get("defaultNamingContext")
      strBase = "<LDAP://" & strDNSDomain & ">"

      ' 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
'===================

Regards,

Rob.

ASKER

Rob the excel can be as i mentioned in the Q or any specific way?

Yes, the way you mentioned at the top of the question.
For example:
Full Name | Login | Email | Manager | Groups | Title | Department | Description
Test User 8 | tuser8 | tuser@maroondah.vic.gov.au | rsampson | Domain Users:IT | Test User Title | Test Department | Test Description

Paste that into Notepad, and you should understand it.

Regards,

Rob.

ASKER

I get this.
---------------------------
Windows Script Host
---------------------------
Script:      C:\Usercreation.vbs
Line:      3
Char:      1
Error:      Object required: 'objRootLDAP'
Code:      800A01A8
Source:       Microsoft VBScript runtime error

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

I have the OU name here is it correct
strOUPath = "OU=Named Accounts," & objRootLDAP.Get("defaultNamingContext")

ASKER

I got that rob...
I get this now

---------------------------
Windows Script Host
---------------------------
Script:      C:\Usercreation.vbs
Line:      76
Char:      19
Error:      The requested operation did not satisfy one or more constraints associated with the class of the object.
Code:      80072014
Source:       (null)

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

ASKER

Rob i have this in the excel...
Full Name Login Email Manager Groups Title Department Description
Sharath S Sharaths@plc.com sharathr Developers Test User Title Chennai-fs Test Description

Line 76 is the password line. Have you got strict password restrictions, and is
strPassword = "defaultpassword"

set secure enough?

Regards,

Rob.

ASKER

Normally we give abc123 as the default password
I have change it to abc123
strPassword = "abc123"

Wait a second....isn't your Login and Email fields around the wrong way?

Notice that I have
Full Name | Login | Email
Test User 8 | tuser8 | tuser8@my.domain

The login automatically has the default naming context appended to it, so you don't need to specify it. If you have already specified it, change this line:
objNewUser.Put "userPrincipalName", strUserName & "@" & Replace(Replace(objRootLDAP.Get("defaultNamingContext"), ",", "."), "DC=", "")

to just this
objNewUser.Put "userPrincipalName", strUserName

Or, just swap the columns around so they are in the right order.

See how you go...

Regards,

Rob.

ASKER

GM Rob
Rob i have some issues in creating the user directly on the dc also i shall check this after i sort that issue.Any help on the software Hta and other posts...

ASKER

Rob succesfully created the user...

Need some changes

In the Users>Accounts tab in ADS there is Userlogon name and next to it a scroll down menu where i have 2 Domain suffix.Need to select 1
Need to have a option in Excel to update the Mobile,Res No and Office No
Will the script create a mailbox also?

1) The login automatically has the default naming context appended to it, so if you have two domains, you will need to change this line:
objNewUser.Put "userPrincipalName", strUserName & "@" & Replace(Replace(objRootLDAP.Get("defaultNamingContext"), ",", "."), "DC=", "")

to just this
objNewUser.Put "userPrincipalName", strUserName

and it should work, but I haven't tested that.

2) Are you "updating" or will these be "added" when a user is created?

3) No, I have never created an Exchange mailbox, although I do have Chandru's script that "apparently" worked......but I can't test it.

Regards,

Rob.

ASKER

I have already changed this part
objNewUser.Put "userPrincipalName", strUserName & "@" & Replace(Replace(objRootLDAP.Get("defaultNamingContext"), ",", "."), "DC=", "")

As you mentioned earlier too.Still does not select the domain name...
With this script will it create a mailbox?

ASKER

If possible please add the Company name

ASKER

Can i rename the text in the excel (Field) as i want....
Is all the data in all the colums mandatory or can i skip any data
Except Name,Nt login,Mailid....

Yeah, I only made the first three fields compulsory, but I haven't actually tested if a user is created successfully with only those, although I don't see why not.....

Rob.

ASKER

I just check it crates with the first 3 fields...

OK, here's a new version that adds the company, and should select your domain name....
'================
' 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=Users,ou=TestOU," & 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)

      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
                  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
                              Set objGroup = GetObject(Get_LDAP_User_Properties("group", "cn", strGroupName, "adsPath"))
                              On Error Resume Next
                              objGroup.Add objNewUser.AdsPath
                              On Error GoTo 0
                              Set objGroup = Nothing
                        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)
      ' Setup ADO objects.
      Set adoCommand = CreateObject("ADODB.Command")
      Set adoConnection = CreateObject("ADODB.Connection")
      adoConnection.Provider = "ADsDSOObject"
      adoConnection.Open "Active Directory Provider"
      adoCommand.ActiveConnection = adoConnection

      ' Search entire Active Directory domain.
      Set objRootDSE = GetObject("LDAP://RootDSE")
      strDNSDomain = objRootDSE.Get("defaultNamingContext")
      strBase = "<LDAP://" & strDNSDomain & ">"

      ' 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
'================

Regards,

Rob.

ASKER

How should the excel file look...
Have you added the telephone fields?
Will it create a mailbox?

1)
the excel file should have these fields in these columns:
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)

where the Groups is the only multi-value one, separated by colon.

2)
I haven't added them yet....I can add Mobile, and Office No phones, but what is Res No?

3)
This cannot create a mailbox yet.....I might be able to incorporate a bit of Chandru's script, but that will be last, because I can't test it....

Regards,

Rob.

ASKER

Ok Rob...In the users Properties in Telephone tab i want the res idence telephone no to reside...
About the mailbox...Please let me know....

ASKER

For this Q...
https://www.experts-exchange.com/questions/22805184/Need-a-logoff-script-to-switch-off-monitors-while-machine-shutting-down.html
I was directed to your posts can you help please...

Sharath, here it is again, with the three additional phone numbers in it, just on the end of the columns:
      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)

'=================
' 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=Users,ou=TestOU," & 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
                              Set objGroup = GetObject(Get_LDAP_User_Properties("group", "cn", strGroupName, "adsPath"))
                              On Error Resume Next
                              objGroup.Add objNewUser.AdsPath
                              On Error GoTo 0
                              Set objGroup = Nothing
                        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)
      ' Setup ADO objects.
      Set adoCommand = CreateObject("ADODB.Command")
      Set adoConnection = CreateObject("ADODB.Connection")
      adoConnection.Provider = "ADsDSOObject"
      adoConnection.Open "Active Directory Provider"
      adoCommand.ActiveConnection = adoConnection

      ' Search entire Active Directory domain.
      Set objRootDSE = GetObject("LDAP://RootDSE")
      strDNSDomain = objRootDSE.Get("defaultNamingContext")
      strBase = "<LDAP://" & strDNSDomain & ">"

      ' 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
'=================

Regards,

Rob.

ASKER

I get this.
---------------------------
Windows Script Host
---------------------------
Script:      C:\Usercreation.vbs
Line:      107
Char:      31
Error:      Invalid procedure call or argument: 'GetObject'
Code:      800A0005
Source:       Microsoft VBScript runtime error

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

Hmmm, that looks like the same story as the other one, with the group name......

Is this group name on a different domain?

Rob.

ASKER

Yes the group is from the Root domain...
I tried a group from the local domain...It works...
Any way to add the roor domain groups also?

ASKER

Rob just checked it works perfect except accepting Root groups...All the others update perfect...

Yeah, I thought so....OK, so same as the other question, do you to put in
domain2.com\groupname

for the other domain, and if the domain is omitted, we'll use the default one?

Rob.

ASKER

Ok Rob...

OK, try this.

Replace the ENTIRE Get_LDAP_User_Properties function at the bottom of the script with this version:

'---------------
Function Get_LDAP_User_Properties(strObjectType, strSearchField, strObjectToGet, strCommaDelimProps)

      If InStr(strObjectToGet, "\") > 0 Then
            arrGroupBits = Split(strObjectToGet, "\")
            strDNSDomain = arrGroupBits(0)
            strDNSDomain = "DC=" & Replace(strDNSDomain, ".", ",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
'---------------

and then make sure you are reference the group name by the full context.
For example, my domain's friendly name is MAROONDAHCC, but the full name is
MAROONDAH.LOCAL

so in my groups list I have
MAROONDAH.LOCAL\IT

Regards,

Rob.

ASKER

Rob in the users properties >Account> User logon name i get a @ after the username.Can you remove this...I think that is not required as the Domain name come with a @

Oh yeah, oops! Good pick up!

Change this line:
strSuffix = "@" & Replace(Replace(objRootLDAP.Get("defaultNamingContext"), ",", "."), "DC=", "")

to this:
strSuffix = Replace(Replace(objRootLDAP.Get("defaultNamingContext"), ",", "."), "DC=", "")

Regards,

Rob.

ASKER

Any help Rob..

Sharath, I think this is same issue as the other one....with adding users to groups from another domain.....when we get that working, we'll come back to this one....

Rob.

ASKER

Ok Rob..

OK, try this.

'===========
' 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=Users,ou=TestOU," & 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
                                    On Error GoTo 0
                                    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
'===========

and then make sure you are referencing the group with it's domain controller and domain name, as we did in the other question.....eg:
INROOTADS03.isoftgroup.co.uk\Chennai_Fs

as long as INROOTADS03 is the name of the domain controller.

Regards.

Rob.

ASKER

Still yet to reflect in ADS waiting for this...Shall rely in some time Rob...
Any help with the other HTA posts

ASKER

Rob i have checked it but it does not add the user to the group....

FYI... just for the fun of it... I will post a Powershell version. I think you love how simple it is :D I just need to test it.

@BSonPosh
I would be very interested to see if PowerShell has an easier way of adding a user to a group that belongs in another domain....this is really cumbersome! Plus I can't test it!

@Sharath, please try this.....it tries a couple of ways of adding a user to another domain's group:
'==============
' 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=Users,ou=TestOU," & 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
                                          boolUserAdded = False
                                          WScript.Echo Err.Number & ": " & Err.Description & " - cannot add " & Replace(objNewUser.AdsPath, "LDAP://", "") & " to " & objGroup.adspath
                                          Err.Clear
                                          On Error GoTo 0
                                          Set objDomUser = GetObject("WinNT://" & strSuffix & "/" & strUserName & ",user")
                                          WScript.Echo "Trying: " & objDomUser.AdsPath
                                          objGroup.Add objDomUser.AdsPath
                                          On Error Resume Next
                                          objGroup.SetInfo
                                          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 " & objDomUser.AdsPath & " to " & objGroup.adspath
                                                Err.Clear
                                                On Error GoTo 0
                                          Else
                                                boolUserAdded = True
                                          End If
                                    Else
                                          boolUserAdded = True
                                    End If
                                    Set objGroup = Nothing
                                    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 " & objGroup.AdsPath
                                    End If
                              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
'=================

Regards,

Rob.

ASKER

Rob..

I get this...
---------------------------
Windows Script Host
---------------------------
-2147016656: - cannot add cn= Sharath Suresh,OU=Named Accounts,OU=User Accounts,OU=IND,OU=Countries,DC=Development,DC=Group,DC=co,DC=uk to LDAP://INROOTADS03.group.co.uk/CN=Chennai_FS,OU=Chennai Distribution Groups,DC=Group,DC=co,DC=uk
---------------------------
OK
---------------------------
Next i get this

---------------------------
Windows Script Host
---------------------------
Script:      C:\Create Login.vbs
Line:      119
Char:      43
Error:      Unspecified error
Code:      80004005
Source:       (null)

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

Sorry, try this....I had the On Error Resume Next in the wrong spot....
'=========================
' 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=Users,ou=TestOU," & 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
                                          boolUserAdded = False
                                          WScript.Echo Err.Number & ": " & Err.Description & " - cannot add " & Replace(objNewUser.AdsPath, "LDAP://", "") & " to " & objGroup.adspath
                                          Err.Clear
                                          On Error GoTo 0
                                          Set objDomUser = GetObject("WinNT://" & strSuffix & "/" & strUserName & ",user")
                                          WScript.Echo "Trying: " & objDomUser.AdsPath
                                          On Error Resume Next
                                          objGroup.Add objDomUser.AdsPath
                                          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 " & objDomUser.AdsPath & " 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
'=========================

Regards,

Rob.

ASKER

I get this.

---------------------------
Windows Script Host
---------------------------
-2147016656: - cannot add cn= Sharath Naresh,OU=Named Accounts,OU=User Accounts,OU=IND,OU=Countries,DC=Development,DC=iSOFTGroup,DC=co,DC=uk to LDAP://INROOTADS03.isoftgroup.co.uk/CN=Chennai_FS,OU=Chennai Distribution Groups,DC=iSOFTGroup,DC=co,DC=uk
---------------------------
OK
---------------------------
Then this...
---------------------------
Windows Script Host
---------------------------
-2147467259: - cannot add WinNT://Development.iSOFTGroup.co.uk/SharathN to LDAP://INROOTADS03.isoftgroup.co.uk/CN=Chennai_FS,OU=Chennai Distribution Groups,DC=iSOFTGroup,DC=co,DC=uk
---------------------------
OK
---------------------------
Then this...
---------------------------
Windows Script Host
---------------------------
Could not add user SharathN to the group Chennai_Fs
---------------------------
OK
---------------------------
Then Done....

Is INROOTADS03 the domain controller name, or a sub domain name?

Rob.

ASKER

User i getting created on both the posts but not adding itself to the group...

ASKER

INROOTADS03 is the root domain name....
The Chennai_fs group is inside a container OU should i even mention the path...

Here is the Powershell Version.
Just had to show you... 59 lines ver 210 lines
And the output is PRETTY! :D

###################################

##### PUT YOUR DATA HERE #######
$Users = import-Csv C:\data\temp\userimport.csv
$password = "P@ssw0rd"
$domain = "lab.com"
$OU = "OU=Temp,DC=Lab,DC=Com"
##### PUT YOUR DATA HERE #######

function Get-UserDN{
Param($usr,$dom)
$root = [ADSI]"LDAP://$dom"
$filter = "(&(objectcategory=user)(sAMAccountName=$usr))"
$searcher = New-Object System.DirectoryServices.DirectorySearcher($root,$filter)
$searcher.findone() | %{$_.properties.distinguishedname}
}
function Add-UsertoGroup{
param($group,$UserDN,$dom)
$root = [ADSI]"LDAP://$dom"
$filter = "(&(objectcategory=group)(Name=$Group))"
$searcher = New-Object System.DirectoryServices.DirectorySearcher($root,$filter)
$grp = ($searcher.findone()).GetDirectoryEntry()
$grp.add("LDAP://$dom/$UserDN")
$grp.SetInfo()
}

foreach($user in $users)
{
Write-Host "+ Creating User <$($User.FullName)>"
# Checking for sAMAccountName/Mail/FullName
if(!$user.Ntlogin){Write-Host " - User $($User.FullName) has no sAMAccountName (ntlogin)";continue}
if(!$user.EmailID){Write-Host " - User $($User.FullName) has no mail (EmailID)";continue}
if(!$user.fullname){Write-Host " - User $($User.ntlogin) has no FullName";continue}
if($user.ManagerName)
{
$manager = Get-UserDN $user.ManagerName -dom $domain
Write-Host " - Manager DN $Manager"
}
# Creating Account in OU
$UserOU = [ADSI]"LDAP://$domain/$OU"

$userObj = $UserOU.Create("User","CN=$($User.FullName)")
$userObj.put("givenName",($user.FullName).Split()[0])
$userObj.put("sn",($user.FullName).Split()[1])
Write-Host " - Setting User NTLogin $($user.NtLogin)";$userObj.put("samAccountName",$user.NtLogin)
Write-Host " - Setting User Email $($user.EmailID)";$userObj.put("mail",$user.EmailID)
if($user.Designation)
{Write-Host " - Setting User Designation $($user.Designation)";$userObj.put("Title",$user.Designation)}
if($user.Description)
{Write-Host " - Setting User Description $($user.Description)";$userObj.put("Description",$user.Description)}
if($user.department)
{Write-Host " - Setting User Department $($user.department)";$userObj.put("department",$user.department)}
$userObj.Setinfo()
$userObj.psbase.invokeset('accountdisabled', $false)
$userObj.Setinfo()
$userObj.psbase.invoke("setpassword",$password)
$userObj.Setinfo()
foreach($g in (($user.Groups).Split(",")))
{
Write-Host " - Adding User to $g"
Add-UsertoGroup -group $g -UserDN $userObj.distinguishedname -dom $domain
}
write-Host
}

###################################
OUTPUT
###################################

+ Creating User <John Smith>
- Manager DN CN=bshell,OU=MyUsers,DC=lab,DC=com
- Setting User NTLogin jsmith
- Setting User Email jsmith@lab.com
- Setting User Designation Loser
- Setting User Description Pretty Cool Guy
- Setting User Department IT
- Adding User to tgroup1
- Adding User to tgroup2

+ Creating User <George Smith>
- Manager DN CN=bshell,OU=MyUsers,DC=lab,DC=com
- Setting User NTLogin gsmith
- Setting User Email gsmith@lab.com
- Setting User Designation Loser
- Setting User Description Pretty Cool Guy
- Setting User Department Sales
- Adding User to tgroup1
- Adding User to tgroup2

ASKER

How should the Csv file be?
Should i put this in a ps1 file and then execute the file?

ASKER CERTIFIED SOLUTION

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

ASKER

Inside the csv file i have data like this.

Full Name UserName Email Manager Groups Title Company Department Description OfficePh MobilePh strHomePh

I went off the colums on the top of the post... I didnt add the other stuff although it would be easy.

BSonPosh, the script that I have provided works well for users and groups within the same domain. I have not had any experience in adding a member of one domain to a group in another, so that is the problem we are having at the moment.....are you able to add users to groups from another domain easily?

@Sharath, I am busy at the moment, I will do some more testing with the code I provided....however, it seems that because you are getting:
LDAP://INROOTADS03.isoftgroup.co.uk/CN=Chennai_FS,OU=Chennai Distribution Groups,DC=iSOFTGroup,DC=co,DC=uk

then that means that you are connecting successfully to the group of the other domain, it's just not adding the user of the current domain, so I think I need to formulate that LDAP string for it's adsPath better....I'll see what I can do......

Regards,

Rob.

ASKER

OK Rob....thanks.....

OK, from reading this....
http://technet2.microsoft.com/WindowsServer/en/library/79d93e46-ecab-4165-8001-7adc3c9f804e1033.mspx?mfr=true

If you look at the "Group Scope", it says in only a "Domain Local" group type, can you have members from other domains.
If you set Chennai_Fs as a Domain Local group, will it allow you to add the user from the other domain?

Regards,

Rob.

ASKER

It is actually a Universal Distribution group do you want me to change to Domain local group?

Maybe do some testing on that first. Create a new Domain Local group, then create one user and try to add it to that group.....

Rob.

ASKER

Rob i just ceated a new group called testing and set local and distribution.After which i ran the script get the same message. Says cannot add the group..

---------------------------
Windows Script Host
---------------------------
-2147016656: - cannot add cn= Sharath Kareem,OU=Named Accounts,OU=User Accounts,OU=IND,OU=Countries,DC=Development,DC=iSOFTGroup,DC=co,DC=uk to LDAP://INROOTADS03.isoftgroup.co.uk/CN=Testing,OU=Chennai Distribution Groups,DC=iSOFTGroup,DC=co,DC=uk
---------------------------
OK
---------------------------

Then

---------------------------
Windows Script Host
---------------------------
-2147467259: - cannot add WinNT://Development.iSOFTGroup.co.uk/Sharathk to LDAP://INROOTADS03.isoftgroup.co.uk/CN=Testing,OU=Chennai Distribution Groups,DC=iSOFTGroup,DC=co,DC=uk
---------------------------
OK
---------------------------
Then this.
---------------------------
Windows Script Host
---------------------------
Could not add user Sharathk to the group testing
---------------------------
OK
---------------------------

Is the Testing group selected as "Domain Local" for the Group Scope, and "Security" for the "Group Type"? If so, then I'm working on trying to get the SID of the user to add it to the other domain....not sure how it works yet.....

Regards,

Rob.

ASKER

The group is distribution...

Try security....it's time to go home for me, but I'm getting closer....I just successfully added a user from another domain using the SID, so I need to figure out to to get the SID easily....hopefully we're not too far away....

Regards,

Rob.

ASKER

Ok GN....

I am not sure exactly what your goal is, but the correct way to do this is to create Groups local (not domain local) to the domain and put those groups in Groups in the other domain. You really should aviod putting users in groups in other domains.

Sharath, sorry for the delay, I have been very busy....here is another go at adding the user to the other group, by using the SID. I have added a couple of extra functions to this to convert the SID to a string.

'====================
' 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=Users,ou=TestOU," & 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
'====================

Regards,

Rob.

ASKER

I get this

---------------------------
Windows Script Host
---------------------------
-2147016651: - cannot add S-1-5-21-1275210071-1979792683-1801674531-15291 to LDAP://INROOTADS03.isoftgroup.co.uk/CN=Testing,OU=Chennai Distribution Groups,DC=iSOFTGroup,DC=co,DC=uk
---------------------------
OK
---------------------------
then

---------------------------
Windows Script Host
---------------------------
Could not add user Sharathk to the group testing
---------------------------
OK
---------------------------
Then
Done

ASKER

Rob please look into this i dont know this will help.
http://searchwincomputing.techtarget.com/tip/0,289483,sid68_gci1089792,00.html
For the Mailbox Part...

ASKER

Rob regarding the groups.you can try later.Can you help adding the user with the mailbox in a specified storage.
As of now i am creating users from the excel only and this works fine.
Only left parts are
1. Adding to groups
2. Mailbox creation
3. Define storage box where it has to created.
4.Add 4 more options address,city,state,pincode in the excel...
Can you help...

ASKER

Rob help on this...Just a reminder...

Sharat, I have NO IDEA if this works, but it's the script from Chandru......and I will also post a "Calling script" at the bottom, that you use to actually run this script....

'=======================
'=======================
'******************************************************************************************
' AutomateMailboxfolder.VBS -- Automate outlook folder creation
' Version: 1.0
' Author: Chandru, ICON.
' Updated: 19:25 PM 29/01/2007
'******************************************************************************************
'//////////////////////////////////////////////////////////////////////////////////
'// Function: CreateMailboxBeforeLogon
'// Purpose: Creates a new user in Active Directory and a mailbox for
'// the new user before they logon.
'//
'// Input: strDCServerName = The domain controller on which the Active
'// Directory users will be created.
'//
'// strServerName = The Exchange server on which the mailboxes
'// will be created.
'// strStorageGroup = The storage group in which the mailboxes
'// will be created.
'// strMailboxStore = The mailbox store in which the mailboxes
'// will be created.
'// strUserFileName = The name of the text file containing the
'// information for the new users.
'// strFolderLang = The language in which the mailbox
'// folders will be created.
'//
'// Example: cscript CreateMailboxBeforeLogon.vbs "DCServerName" "ServerName" "First Storage
'// Group" "Mailbox Store (SERVERNAME)" "UserFile.txt" "en-us"
'//
'// The UserList.txt file format example:
'//
'// John;Doe
'//
'// So the format is: FirstName;LastName
'//
'// The script creates log file UserMail.log in directory where te script was run from
'//
'/////////////////////////////////////////////////////////////////////////////////

Option Explicit

Call AutomateMailboxCreation
Sub AutomateMailboxCreation
On Error Resume Next
' Check number of input arguments.
If wscript.Arguments.count <> 6 Then
      wscript.echo "There were an incorrect amount of arguments passed."
      wscript.Quit
End If

' Declare variables for input parameters.
Dim strDCServerName 'As String
Dim strServerName 'As String
Dim strStorageGroup 'As String
Dim strMailboxStore 'As String
Dim strGivenName 'As String
Dim strSurname            'As String
Dim strAlias 'As String
Dim strPassword 'As String
Dim strFolderLang '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
Dim mbx
Dim bFound ' 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 arrNewUsersInfo
'Dim strCurrUserInfo
'Dim arrCurrUserInfo
'Dim fs ' As FileSystemObject
'Dim tsNewUsers ' As FSO.TextStream
'Dim iLineNum ' As Integer
'Dim bContinue ' As Boolean
'Dim TimeInterval
'Dim NumofTry 'As Integer
'Dim iCounter 'As Integer
'===============================================================================================
' Dim ath, ath1, ath2
Dim Msg
Dim tsNewUsersLog
Dim where
Dim strLogFile

strLogFile = "UserMail.log"

'===============================================================================================
' Get input parameters.
strDCServerName = wscript.Arguments(0)
strServerName = wscript.Arguments(1)
strStorageGroup = wscript.Arguments(2)
strMailboxStore = wscript.Arguments(3)
strGivenName = wscript.Arguments(4)
strSurname = wscript.Arguments(5)
strFolderLang = wscript.Arguments(6)

'strDCServerName = Inputbox("Enter the local Domain controller name","Domain Controller","Server1")
'IF StrDCServername ="" Then
'Msgbox "Domain Controller info was not provided."
'Wscript.quit
'End If
'strServerName = Inputbox("Enter the Exchange server name","Exchange Server","server2")
'IF strServerName ="" Then
'Msgbox "Exchange server info was not provided"
'Wscript.quit
'End If
'strStorageGroup = Inputbox("Enter the name of the Storage group","Storage Group","SG4")
'IF strStorageGroup ="" Then
'Msgbox "Storage group info was not provided"
'Wscript.quit
'End If
'strMailboxStore = Inputbox("Enter the name of the mailbox store","Mailbox Store","Resource")
'IF strMailboxStore ="" Then
'Msgbox "Mailbox info was not provided"
'Wscript.quit
'End IF
'strUserFileName = Inputbox("Enter the name of the file",,"UserList.txt")
'strFolderLang = Inputbox("Enter the name of the language","Lanaguage","EN-US")
'IF strFolderLang ="" Then
'Msgbox "Language info was not provided"
'Wscript.quit
'End IF

' Validate input parameters.
If ValidateInput(strDCServerName) = False Then wscript.Quit
If ValidateInput(strServerName) = False Then wscript.Quit
If ValidateInput(strStorageGroup) = False Then wscript.Quit
If ValidateInput(strMailboxStore) = False Then wscript.Quit

' 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 strServerName

' 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 <> 0 Then
wscript.echo "An error occurred opening the specified storage group."
wscript.echo "Error: 0x" & Hex(Err.Number) & " " & Err.Description
wscript.echo "Exiting the application."

' Clean up.
Set objSG = Nothing

' Exit the application.
wscript.Quit
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
Wscript.echo "The specified mailbox store could not be found."
Wscript.Quit
End If

' Create the FileSytemObject object.
Set fs = CreateObject("Scripting.FileSystemObject")
'===============================================================================================

'Build path for the log file - NOT USED
'ath = fs.GetAbsolutePathName(strUserFileName)
'ath1 = instrrev(ath, "\")
'ath = left(ath, len(ath)-ath1)
'ath2 = ath & "UserMail.log"

'===============================================================================================

' Open the log file
Set tsNewUsersLog = fs.OpenTextFile(strLogFile, 2, 1)

If Err <> 0 Then

wscript.echo "An error occurred creating the log file."
wscript.echo "Error: " & Err.Number & " " & Err.Description
wscript.echo "Exiting the application."

err.clear
set fs = Nothing
set tsNewUsersLog = Nothing

wscript.Quit
End If

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

' Error handling.
'If Err <> 0 Then

' LogMessage tsNewUsersLog, "An error occurred opening the file of new users."
' LogMessage tsNewUsersLog, "Error: " & Err.Number & " " & Err.Description
' LogMessage tsNewUsersLog, "Exiting the application."

' wscript.echo "An error occurred opening the file of new users."
' wscript.echo "Error: " & Err.Number & " " & Err.Description
' wscript.echo "Exiting the application."

' Clean up.
' Set fs = Nothing
' Set tsNewUsers = Nothing
' Set tsNewUserLog = 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)
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) = 1 Then

' Get the given name, surname, e-mail alias,
' and password from the array.
' strGivenName = arrCurrUserInfo(0)
' strSurname = arrCurrUserInfo(1)
' strGivenName = Inputbox("Enter the Firstname")
' strSurname = Inputbox("Enter the Lastname")

'strAlias = strGivenName & "_" & strSurname
'strAlias = strSurname & Left(strGivenName,1)
strAlias = strGivenName
'===============================================================================================
'============= what the password is set to =============================================================
strPassword = "Pa$$word12"
'===============================================================================================
'===============================================================================================

' Display the e-mail alias.
LogMessage tsNewUsersLog, "Script started at " & now
LogMessage tsNewUsersLog, strAlias & " ..."
' wscript.echo strAlias & " ..."

' Validate the given and surnames.
If ValidateName(strGivenName) = False Then 'Or ValidateName(strSurname) = False
bContinue = False
End If

' Validate the e-mail alias.
If ValidateAlias(strAlias) = False Then
bContinue = False
End If
' Else
' 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, objUser, strDomainDN)

End If

' If the user object was successfully created, then
' attempt to create the mailbox.
If bContinue Then

' Initialize the variables.
TimeInterval = 60000
NumofTry = 10
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
' 60 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
LogMessage tsNewUsersLog, "Failed to create a mailbox for " & strAlias & "."
' 'wscript.echo "Failed to create a mailbox for " & strAlias & "."
bContinue = False
End If
End If

' If the mailbox was created, then attempt to force the
' Exchange server to create the mailbox folders.
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 60 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(strServerName, strDomainDN, strAlias, _
strPassword, strFolderLang) Then Exit Do
iCounter = iCounter + 1
Loop

' Could not create the mailbox folders after NumofTry attempts.
If iCounter >= NumofTry Then
wscript.echo "Failed to create the mailbox folders for " & strAlias & " before logon."
End If
End If
LogMessage tsNewUsersLog, " "
' wscript.echo("")

'Next

' Close the file.
tsNewUsers.Close
tsNewUsersLog.Close

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

' Exit the application.
'Wscript.Echo "Script Completed. Continuing with group creation in AD...........!"
Wscript.Echo "Script Completed. Please check that the mailbox was created for " & strGivenName & " " & strSurname
Wscript.Quit

'AD Group Creation
Const ADS_GROUP_TYPE_GLOBAL_GROUP = &H2
Const ADS_GROUP_TYPE_DOMAIN_LOCAL_GROUP = &H4
Const ADS_GROUP_TYPE_UNIVERSAL_GROUP = &H8
Const ADS_GROUP_TYPE_SECURITY_ENABLED = &H80000000

Dim StrOU, StrNewGroup, StrNewGroupLong, StrGroupname, strDNSDomain
Dim objOU, objGroup, objRootDSE

'strOU="OU=Mailbox Security Groups,OU=Application Accounts,"
strOU="OU=Service Accounts,OU=Ireland,"
strGroupname = stralias
IF strGroupname ="" then
Msgbox "Groupname info was not provided"
Wscript.quit
End IF
strNewGroup = stralias & " Mailbox"

'Msgbox strnewgroup

strNewGroupLong = "CN=" & strNewGroup

'Msgbox StrNewGroupLong

' Bind to Active Directory
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("DefaultNamingContext")

'Msgbox strDNSDomain

' Create new Group
Set objOU = GetObject("LDAP://" & strOU & strDNSDomain )
Set objGroup = objOU.Create("Group",strNewGroupLong)
objGroup.Put "sAMAccountName", strNewGroup
objGroup.Put "Description", "Mailbox group for Eroom " & strGroupname
' Here is where you set the group Type and Scope
objGroup.Put "groupType", ADS_GROUP_TYPE_UNIVERSAL_GROUP _
or ADS_GROUP_TYPE_SECURITY_ENABLED
objGroup.setInfo

Wscript.Echo "Group " & strNewGroup & " Created Successfully. Continuing with Adding the mailbox rights....!"

'Mailbox rights
CONST ADS_ACETYPE_ACCESS_ALLOWED = 0
CONST ADS_ACETYPE_ACCESS_DENIED = 1
CONST ADS_ACETYPE_SYSTEM_AUDIT = 2
CONST ADS_ACETYPE_ACCESS_ALLOWED_OBJECT = 5
CONST ADS_ACETYPE_ACCESS_DENIED_OBJECT = 6
CONST ADS_ACETYPE_SYSTEM_AUDIT_OBJECT = 7
CONST ADS_ACETYPE_SYSTEM_ALARM_OBJECT = 8

CONST ADS_ACEFLAG_INHERIT_ACE = 2
CONST ADS_RIGHT_DS_CREATE_CHILD = 1
Const ADS_READ_MAILBOX_PERMS = &h20000
Const EX_MB_SEND_AS_ACCESSMASK = &H00100
const SEND_AS = &h2
const ASSOCIATED_EXTERNAL = &h4

Dim objUser2
Dim oSecurityDescriptor
Dim dacl
Dim ace
Dim strRecipient, sUserADspath, STrustee

' ********************************************************************
' Change this variable according to your environment.

StrRecipient = "CN=" & stralias
sUserADsPath = "LDAP://" & StrDCServername & "/" & strRecipient & ",OU=Service Accounts,DC=ab,DC=abc,DC=com"

'wscript.echo suserADSpath
sTrustee = "ICON-EU\" & strNewGroup

'wscript.echo Strustee

' ********************************************************************
'Get directory user object.
Set objUser2 = GetObject(sUserADsPath)

' Get the Mailbox security descriptor (SD).
Set oSecurityDescriptor = objUser2.MailboxRights

' Extract the Discretionary Access Control List (DACL) using the IADsSecurityDescriptor.
' Interface.
Set dacl = oSecurityDescriptor.DiscretionaryAcl
Set ace = CreateObject("AccessControlEntry")

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' The following block of code demonstrates how to read all the
' ACEs on a DACL for the Exchange 2000 mailbox.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'wscript.echo "Here are the existing ACEs in the mailbox's DACL:"
'
'' Enumerate all the Access Control Entries (ACE) in the DACL using the IADsAccessControlList.
'' Interface, therefore, displaying the current mailbox rights.
'wscript.echo "Trustee, AccessMask, ACEType, ACEFlags, Flags, ObjectType, InheritedObjectType"

'Reporting commented out. Uncomment to see permissions.
For Each ace In dacl
'' Display all the properties of the ACEs using the IADsAccessControlEntry interface.
' msgbox ace.Trustee & ", " & ace.AccessMask & ", " & ace.AceType & ", " & ace.AceFlags & ", " & ace.Flags & ", " & ace.ObjectType & ", " & ace.InheritedObjectType
Next

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' The following block of code demonstrates adding a new ACE to the DACL
' for the Exchange 2003/2000 mailbox with the Trustee specified in sTrustee,
' which permits full control over this mailbox.
' This is the same task that is performed by ADUnC when you follow these
' steps to modify the properties of a user: on the Exchange Advanced tab,
' under Mailbox Rights, click Add, select the Trustee, and then select the
' Full Mailbox Access Rights check box.
' Similarly, you can also remove ACEs from this ACL by using the IADsAccessControlEntry interfaces.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

' Template: AddAce(TrusteeName, gAccessMask, gAceType, gAceFlags, gFlags, gObjectType, gInheritedObjectType)
'AddAce dacl, sTrustee, ADS_RIGHT_DS_CREATE_CHILD + ADS_READ_MAILBOX_PERMS, _
' ADS_ACETYPE_ACCESS_ALLOWED, ADS_ACEFLAG_INHERIT_ACE, 0, 0, 0

AddAce dacl, sTrustee, ADS_RIGHT_DS_CREATE_CHILD + ADS_READ_MAILBOX_PERMS, _
ADS_ACETYPE_ACCESS_ALLOWED, ADS_ACEFLAG_INHERIT_ACE, 0, 0, 0

' Add the modified DACL to the security descriptor.
oSecurityDescriptor.DiscretionaryAcl = dacl

' Save new SD onto the user.
objUser2.MailboxRights = oSecurityDescriptor

' Commit changes from the property cache to the information store.
objUser2.SetInfo

MsgBox "Done modifying the mailbox permissions for Full Control"

End Sub

'********************************************************************
'*
'* Function AddAce(dacl, TrusteeName, gAccessMask, gAceType,
'* gAceFlags, gFlags, gObjectType, gInheritedObjectType)
'*
'* Purpose: Adds an ACE to a DACL
'* Input: dacl Object's Discretionary Access Control List
'* TrusteeName SID or Name of the trustee user account
'* gAccessMask Access Permissions
'* gAceType ACE Types
'* gAceFlags Inherit ACEs from the owner of the ACL
'* gFlags ACE has an object type or inherited object type
'* gObjectType Used for Extended Rights
'* gInheritedObjectType
'*
'* Output: Object - New DACL with the ACE added
'*
'********************************************************************

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

' Destroy objects.
Set Ace1 = Nothing
End Function

'Cleanup
sUserADsPath = ""
sTrustee = ""

Wscript.echo "Exchange mailbox and Outlook configuration completed. Cheers"
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.
'//
'// 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, 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=" & strAlias
strRecip = "CN=" & strAlias

' Get the container.
'===============================================================================================
'======= change the "OU=Test Accounts," to OU where you want users to be created ===============
'======= EXAMPLES: "OU=Users,OU=IMS,OU=Business Units," to create user for IMS
'======= "OU=Users,OU=Aviation Group,OU=Business Units," to create user for Aviation
Set objContainer = GetObject("LDAP://" & strDCServerName & "/" & "OU=Service Accounts,OU=India," & _
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", stralias
objUser.Put "sAMAccountName", strAlias
objUser.Put "givenName", strGivenName
objUser.Put "sn", strSurname
objUser.Put "Description", "Mailbox for Eroom " & strAlias

'===============================================================================================
'===============================================================================================
'=== change UPN suffix to what you need - @domain etc. ==================

objUser.Put "userPrincipalName", strAlias & "@ab.abc.com"

'===============================================================================================
'===============================================================================================
' Save the changes to the user object.
objUser.SetInfo

' Error handling.
If Err.Number <> 0 Then
LogMessage tsNewUsersLog, "Error creating user object for " & strAlias
LogMessage tsNewUsersLog, "Error: " & Err.Number & " " & Err.Description
' wscript.echo "Error creating user object for " & strAlias
' wscript.echo "Error: " & Err.Number & " " & Err.Description

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

If Err.Number = -2147019886 Then
LogMessage tsNewUsersLog, "The object already exists."
' wscript.echo "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

'===============================================================================================
'===============================================================================================
'========== comment out if you do not want "change password at the next logon" activated =======

objUser.Put "pwdLastSet", -1

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

'===============================================================================================
'===== comment previous line and uncomment next line if you want create disabled account =======

' objUser.AccountDisabled = True

'===============================================================================================
'===============================================================================================

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

LogMessage tsNewUsersLog, "User object for " + strAlias + " created successfully."
' wscript.echo "User object for '" + strAlias + "' created successfully."

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
LogMessage tsNewUsersLog, "Error creating mailbox for " & strAlias
LogMessage tsNewUsersLog, "Error: " & Err.Number & " " & Err.Description
' wscript.echo "Error creating mailbox for " & strAlias
' wscript.echo "Error: " & Err.Number & " " & Err.Description

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

CreateNewUserMailbox = False
Exit Function
End If
'===============================================================================================
'============== comment out the next two lines if you do not want to hide the user =============
objUser.Put "msExchHideFromAddressLists", False
objUser.SetInfo
'===============================================================================================
'===============================================================================================
' Clean up.
Set objUser = Nothing
Set objMailbox = Nothing

LogMessage tsNewUsersLog, "Mailbox for " + stralias + " created successfully."
'wscript.echo "Mailbox for " + strAlias + " created successfully."
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: strServerName = 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(strServerName, 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://" & strServerName & "/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
' LogMessage tsNewUsersLog, "Mailbox folders for " & strAlias & " successfully created."
'wscript.echo "Mailbox folders for " & strAlias & " successfully created."
' CreateMailboxFolders = True
' Else
'GET method did not successfully force creation of mailbox folders.
' CreateMailboxFolders = False
' End If

' Set oXMLHTTP = Nothing
'End Function

'//////////////////////////////////////////////////////////////////////////////////
'// 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
LogMessage tsNewUsersLog, "The length of the specified server, mailbox store, or storage group name" _
+ " cannot exceed 64 characters."
' wscript.echo "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
LogMessage tsNewUsersLog, "The specified server, mailbox store, or storage group name cannot contain ';', '\', or '/'."
' wscript.echo "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
LogMessage tsNewUsersLog, "The length of the e-mail alias cannot exceed 256 characters."
' wscript.echo "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
LogMessage tsNewUsersLog, "The specified server, mailbox store, or storage group name cannot contain ':', '*', " & _
" '|', ';', '<', '>', or '""'."
' wscript.echo "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
LogMessage tsNewUsersLog, "The length of the name cannot exceed 28 characters."
' wscript.echo "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
LogMessage tsNewUsersLog, "The specified name cannot contain '<script'."
' wscript.echo "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

'================================================================================================

Sub LogMessage(where, Msg)

Wscript.Echo msg
where.WriteLine msg

End Sub

'================================================================================================
'=======================
'=======================

And here is the script you can use to run that....

'===============
'============
strDCServerName = "server"            ' For Active Directory
strServerName = "exchange"            ' For Exchange Mailbox
strStorageGroup = "group"            ' The Storage Group for the Mailbox
strMailboxStore = "mailboxstore"' The Store for the Mailbox
strGivenName = "John"            ' The first name of the user
strSurname = "Smith"            ' The last name of the user
strFolderLang = "en-us"                  ' The language of the Mailbox
strCommand = "wscript.exe c:\temp\Scripts\Create_AD_User_With_HTA\AutomateMailboxFolder.vbs """ & strDCServerName & """ """ & strServerName & """ """ & strStorageGroup & """ """ & strMailboxStore & """ """ & strGivenName & """ """ & strSurname & """ """ & strFolderLang & """"
Set objShell = CreateObject("WScript.Shell")
MsgBox strCommand
objShell.Run strCommand, 0, True
'===========
'===============

Good luck!

Rob.

ASKER

Rob is the whole thing a single vbs script.
Should i give the names here in the bottom of the script.
What about the excel script...

The whole part above where I said:
"And here is the script you can use to run that...."

is one entire, massive script, so yes, save all of that as
AutomateMailboxFolder.vbs

and then in the second script, change this line:
strCommand = "wscript.exe c:\temp\Scripts\Create_AD_User_With_HTA\AutomateMailboxFolder.vbs """ & strDCServerName & """ """ & strServerName & """ """ & strStorageGroup & """ """ & strMailboxStore & """ """ & strGivenName & """ """ & strSurname & """ """ & strFolderLang & """"

to reflect the path to that file, such as:
strCommand = "wscript.exe c:\AutomateMailboxFolder.vbs """ & strDCServerName & """ """ & strServerName & """ """ & strStorageGroup & """ """ & strMailboxStore & """ """ & strGivenName & """ """ & strSurname & """ """ & strFolderLang & """"

And this is independant of the Excel script......and even if it does work, for it to work from the Excel file, you would have to write the same parameters into columns in the Excel file.....

Regards,

Rob.

ASKER

Rob should i specify the dc name ,storagename,etc. in this part.
strCommand = "wscript.exe c:\AutomateMailboxFolder.vbs """ & strDCServerName & """ """ & strServerName & """ """ & strStorageGroup & """ """ & strMailboxStore & """ """ & strGivenName & """ """ & strSurname & """ """ & strFolderLang & """"

No, just change these parameters above that bit:
strDCServerName = "server" ' For Active Directory
strServerName = "exchange" ' For Exchange Mailbox
strStorageGroup = "group" ' The Storage Group for the Mailbox
strMailboxStore = "mailboxstore"' The Store for the Mailbox
strGivenName = "John" ' The first name of the user
strSurname = "Smith" ' The last name of the user
strFolderLang = "en-us" ' The language of the Mailbox

Regards,

Rob.

ASKER

I get this.

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

---------------------------
wscript.exe c:\AutomateMailboxFolder.vbs "inuh01" "ineange01" "First Administrative Group" "First Storage Group" "Sha" "red" "en-us"
---------------------------
OK
---------------------------

Then this
---------------------------
Windows Script Host
---------------------------
There were an incorrect amount of arguments passed.
---------------------------
OK
---------------------------

At about line 45 of the big one, there is this line:
If wscript.Arguments.count <> 6 Then

that should be
If wscript.Arguments.count <> 7 Then

then see what happens....

Regards,

Rob.

ASKER

I get this.
---------------------------
Windows Script Host
---------------------------
An error occurred opening the specified storage group.
---------------------------
OK
---------------------------
Then this
---------------------------
Windows Script Host
---------------------------
Error: 0x1A8 Object required
---------------------------
OK
---------------------------

then this
---------------------------
Windows Script Host
---------------------------
Exiting the application.
---------------------------
OK
---------------------------
the excel file in where related to this script right.
Only 2 files are required .

ASKER

Rob i tryed running this from the exchange itself and i get this.

---------------------------
Windows Script Host
---------------------------
Error: 0x1F4 Variable is undefined
---------------------------
OK
---------------------------

ASKER

Rob i even tried with different storage groups...But still get the same error.
Shall i close this and raise a new Q for thr expansion of mailbox as this Q is so big that it takes a long time to load the page....

LOL! Yeah, agreed. That would probably be a good idea to focus on a single script just to create the mailbox....

Rob.

ASKER

Rob GM,

Here is the new post
https://www.experts-exchange.com/questions/22846683/Create-users-and-mailboxes-from-a-excel.html

THX
Sharath