[2 days left] What’s wrong with your cloud strategy? Learn why multicloud solutions matter with Nimble Storage.Register Now

x
?
Solved

VB Script to Bulk Add users from CSV

Posted on 2007-11-16
7
Medium Priority
?
2,054 Views
Last Modified: 2012-06-27
Hi All,

I hope you can help !

I need a VB script that will allow me to bulk add users from a CSV file.  The only fields I need to fill in are the mandatory fields - eg username, password, firstname, lastname and make them a member of an OU and a group.  I also need to be able to create a folder and make it a hidden share on our filer and then grant the user rights to that folder.  I also need to check whetehr the username already exists.

Ive looked at quite a few scripts on here but not many of them seem to do the job above.  Some can do it but they dont use CSV or visa versa.  My VBS is very limited and its a bit scarey when you look at some of the code.

Any help would be appreciated :-)
0
Comment
Question by:dgirl365
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
7 Comments
 
LVL 29

Expert Comment

by:Michael Worsham
ID: 20298984
0
 
LVL 26

Expert Comment

by:Farhan Kazi
ID: 20299079
Hi dgirl365,
Why not using Windows builtin tool called CSVDE.exe for bulk import and export operations?

Have a look following step-by-step guide.
http://www.computerperformance.co.uk/Logon/Logon_CSVDE_Bulk.htm
http://www.computerperformance.co.uk/Logon/Logon_CSVDE_import.htm

If you need further help regarding CSVDE do let me know.
Farhan
0
 
LVL 70

Expert Comment

by:KCTS
ID: 20299141
I prefer DSAdd User eg.

dsadd user CN=JohnG,CN=Users,DC=Acme,DC=inc -samID JohnG -upn JohnG@Acme.inc -title "Manager" -dept "Management" -fn John -ln Grimshaw -pwd Pa$$w0rd -disabled No -display "John Grimshaw" -mustchpwd No -canchpwd Yes

dsadd user CN=SusanF,CN=Users,DC=Acme,DC=inc -samID SusanF -upn SusanF@Acme.inc -title "Manager" -dept "Management" -fn Susan -ln Fines -pwd Pa$$w0rd -disabled No -display "Susan Fines" -mustchpwd No -canchpwd Yes

You can use word to build the DSAdd commands from a CSV file
0
Are your AD admin tools letting you down?

Managing Active Directory can get complicated.  Often, the native tools for managing AD are just not up to the task.  The largest Active Directory installations in the world have relied on one tool to manage their day-to-day administration tasks: Hyena. Start your trial today.

 
LVL 11

Accepted Solution

by:
bsharath earned 1200 total points
ID: 20317704
First name and user name is compulsary
First name enter will take the last name field also
If i give Shaath Reddy in First name
then Reddy will be taken as last Name
local groups can be given in the excel....
Email Id is not mandatory
make sure you put the Fullname with a space between first name and lastname Ex: (Sharath Reddy)
manager names should be NTlogin only
Change the strOUPath as per your OU path where you want to create the user
strPassword  change this part with your password
Change the strExcelFile with the xls filename you want
This script is given by Rob to me and works great...
'====================
' Bind to Active Directory.
Set objRootLDAP = GetObject("LDAP://rootDSE")

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

' END CONFIGURATION PARAMETERS

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

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

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

      strFullName = Trim(objExcel.ActiveSheet.Cells(intRow, "A").Value)
      strUserName = Trim(objExcel.ActiveSheet.Cells(intRow, "B").Value)
      strEmail = Trim(objExcel.ActiveSheet.Cells(intRow, "C").Value)
      strManager = Trim(objExcel.ActiveSheet.Cells(intRow, "D").Value)
      strGroups = Trim(objExcel.ActiveSheet.Cells(intRow, "E").Value)
      strTitle = Trim(objExcel.ActiveSheet.Cells(intRow, "F").Value)
      strCompany = Trim(objExcel.ActiveSheet.Cells(intRow, "G").Value)
      strDepartment = Trim(objExcel.ActiveSheet.Cells(intRow, "H").Value)
      strDescription = Trim(objExcel.ActiveSheet.Cells(intRow, "I").Value)
      strOfficePh = Trim(objExcel.ActiveSheet.Cells(intRow, "J").Value)
      strMobilePh = Trim(objExcel.ActiveSheet.Cells(intRow, "K").Value)
      strHomePh = Trim(objExcel.ActiveSheet.Cells(intRow, "L").Value)
      strStreet = Trim(objExcel.ActiveSheet.Cells(intRow, "M").Value)
      strCity = Trim(objExcel.ActiveSheet.Cells(intRow, "N").Value)
      strState = Trim(objExcel.ActiveSheet.Cells(intRow, "O").Value)
      strZip = Trim(objExcel.ActiveSheet.Cells(intRow, "P").Value)
      strCountry = Trim(objExcel.ActiveSheet.Cells(intRow, "Q").Value)
     
      strFirstName = Trim(Left(strFullName, InStrRev(strFullName, " ") - 1))
      strLastName = Trim(Mid(strFullName, InStrRev(strFullName, " ") + 1))
           
      If strFullName <> "" And strUserName <> "" 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
                  If strEmail <> "" Then objNewUser.Put "mail", strEmail
                  If strManager <> "" Then
                        strManagerADsPath = Get_LDAP_User_Properties("user", "samAccountName", strManager, "adsPath")
                        If InStr(UCase(strManagerADsPath), "LDAP://") > 0 Then
                              Set objManager = GetObject(strManagerADsPath)
                              objNewUser.Put "manager", Replace(objManager.AdsPath, "LDAP://", "")
                              Set objManager = Nothing
                        Else
                                WScript.Echo strManager & " was Not found. Cannot set Manager"
                        End If
                  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
                  If strStreet <> "" Then objNewUser.Put "streetAddress", strStreet
                  If strCity <> "" Then objNewUser.Put "l", strCity
                  If strState <> "" Then objNewUser.Put "st", strState
                  If strZip <> "" Then objNewUser.Put "postalCode", strZip
                  ' ISO Country Code list: http://www.iso.org/iso/english_country_names_and_code_elements
                  If strCountry <> "" Then objNewUser.Put "c", strCountry
                  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
'====================

The excel should look like this...
Full Name          UserName        Email                               Manager           Groups                   Title                  Company        Department               Description      OfficePh      MobilePh      Â Â Â Â Â strHomePh       Street Address      City      State      Zip      Country
Each at a colum

Hope this helps....
0
 

Author Comment

by:dgirl365
ID: 20321404
Thanks - Ill give it a go !!!!!!!!! :)
0
 
LVL 29

Expert Comment

by:Michael Worsham
ID: 20640445
Any luck into using any of the above methods?
0

Featured Post

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.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This process allows computer passwords to be managed and secured without using LAPS. This is an improvement on an existing process, enhanced to store password encrypted, instead of clear-text files within SQL
Wouldn't it be nice if objects in Active Directory automatically moved into the correct Organizational Units? This is what AutoAD aims to do and as a plus, it automatically creates Sites, Subnets, and Organizational Units.
This tutorial will walk an individual through the process of transferring the five major, necessary Active Directory Roles, commonly referred to as the FSMO roles to another domain controller. Log onto the new domain controller with a user account t…
This tutorial will walk an individual through the process of configuring their Windows Server 2012 domain controller to synchronize its time with a trusted, external resource. Use Google, Bing, or other preferred search engine to locate trusted NTP …

649 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question