Solved

VB Script to Bulk Add users from CSV

Posted on 2007-11-16
7
2,045 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
7 Comments
 
LVL 29

Expert Comment

by:Michael W
Comment Utility
0
 
LVL 26

Expert Comment

by:farhankazi
Comment Utility
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
Comment Utility
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
Highfive Gives IT Their Time Back

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 
LVL 11

Accepted Solution

by:
bsharath earned 300 total points
Comment Utility
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
Comment Utility
Thanks - Ill give it a go !!!!!!!!! :)
0
 
LVL 29

Expert Comment

by:Michael W
Comment Utility
Any luck into using any of the above methods?
0

Featured Post

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

Suggested Solutions

Starting in Windows Server 2008, Microsoft introduced the Group Policy Central Store. This automatically replicating location allows IT administrators to have the latest and greatest Group Policy (GP) configuration settings available. Let’s expl…
Mapping Drives using Group policy preferences Are you still using old scripts to map your network drives if so this article will show you how to get away for old scripts and move toward Group Policy Preference for mapping them. First things f…
This tutorial will walk an individual through the steps necessary to join and promote the first Windows Server 2012 domain controller into an Active Directory environment running on Windows Server 2008. Determine the location of the FSMO roles by lo…
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…

763 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

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now