• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 368
  • Last Modified:

Create users from excel (Continuation)

Hi,

The continuation of this Q...
http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_22846683.html

1. Need to auto select the "Account tab" User logon name next to it the domain name "Development" has to be selected.
2. Password never expires has to be selected.
3. In Telephones tab the Home,Mobile has to be available in csv
4. Notes colum
5. Title
6. Manager
7. Groups adding local as well as Root domain groups from the csv.
8. Description in the first row.

What is the Alias there for....?
Can these details be integreted in the script as these will very rarely change.
CompanyName,Exchange Server,First Storage Group,Mailbox Store
Regards
Sharath
0
bsharath
Asked:
bsharath
  • 16
  • 10
  • 2
1 Solution
 
bsharathAuthor Commented:
Email adress is automatically taken from First name and Last name. So can we remove the option from vbs as well csv
0
 
bsharathAuthor Commented:
In ADS the Mailbox rights for the created user is just "SELF" is it correct.
0
 
RobSampsonCommented:
Sharath, for point number 1, with the code in
http://www.experts-exchange.com/OS/Microsoft_Operating_Systems/Q_22804838.html

if you don't worry about groups just yet...and it creates a user, does that domain get selected from that box on the Accounts tab?

Regards,

Rob.
0
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 
bsharathAuthor Commented:
No the domain name does not get selected....
0
 
chandru_solCommented:
Yes it is correct and when the user login everything will populate and now only it will be "SELF"
0
 
bsharathAuthor Commented:
Ok Chandru...
0
 
chandru_solCommented:
Can you try a user logging in and see if it populates all the ACL (access control list)?
0
 
bsharathAuthor Commented:
No the rights did not populate after logging in aswell.

Rob & Chandru any progress with this....
I am expecting another bunch of user creation.If this is done by then it would be of great help...
0
 
chandru_solCommented:
Your requirement for 1 - 6 can be done easily. I will work on this and will post the code late today as i will be out.
0
 
bsharathAuthor Commented:
Ok Chandru...
0
 
RobSampsonCommented:
Chandru, this is code that I was getting Sharath to use to add a user to the AD from Excel.  The excel fields are as follows:
      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)

Seeing as you use Exchange, and can create the mailboxes, are you able to combine the script below with the one that create mailboxes to have it work with all the details?

This is very hard for me to do because I can't test it.....

'====================
' 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.
0
 
chandru_solCommented:
Thanks Rob! I will combine this and will test the code.
0
 
bsharathAuthor Commented:
Awaiting the final code :)
0
 
bsharathAuthor Commented:
Chandru did you have the chance to check the script...
0
 
chandru_solCommented:
No Sharath! Sorry about that. I am afraid I will be able to work only this weekend on this script.
0
 
bsharathAuthor Commented:
Chandru did you have the time to check....
0
 
chandru_solCommented:
Sharath,

I am not in chennai and working from Bangalore as a case of emergency. I will be filying back today night. I will give it a go tomorrow

:)
0
 
chandru_solCommented:
Are you still waiting for the script to create 300 users or you have already finished them?
0
 
bsharathAuthor Commented:
I have started them but not completed....Need to finish them this week...
Until then everyone will login in a common user id...

Still need it very badly...
0
 
bsharathAuthor Commented:
Any Luck on this today....
0
 
chandru_solCommented:
Sorry Sharath, I didn't have to time to test this and work on this.

Rob and me are looking on a way to add the users to the Root groups.

I will look into other post above and see where i can be of help

I think you are mainitaining a separate database for the EE questions. :-)

regards
Chandru
0
 
bsharathAuthor Commented:
Yes chandru so many excllent solutions and it becomes difficult to remember.So just creating a seperate database.of all the solutions that i got from you experts and storing them for future reference...
0
 
chandru_solCommented:
Yes that's true.....

Are you maintianing it in excel or access database?

Cheers
Chandru
0
 
bsharathAuthor Commented:
I am creating a new local machine website for this...Which can be shared with my team also.As they dont have access to EE.
0
 
bsharathAuthor Commented:
0
 
chandru_solCommented:
Sorry i didn't have time to check

Will work whenever i get time and will post my comments
0
 
bsharathAuthor Commented:
Chandru & Rob i shall close this Question here today...
Chandru please let me know when your free and you are done with the testing...

Planned to close all my posts today and have "0" questions open this year :-)

Hope Rob shall help me doing so....
0

Featured Post

New feature and membership benefit!

New feature! Upgrade and increase expert visibility of your issues with Priority Questions.

  • 16
  • 10
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now