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

VBscript enable and update password if user exists in excel

hi,

hi have this script for importing users from a excel sheet, my only problem is when script finds existing user in AD from excel sheet it stops and i would like the script to enable and changing the attributes in AD from excel, fullname,username,password,office,phone,homedirectory,profilepath.
this is my script:

If LCase(Right(Wscript.FullName, 11)) = "wscript.exe" Then
        strPath = Wscript.ScriptFullName
        strCommand = "%comspec% /k cscript  """ & strPath & """"
        Set objShell = CreateObject("Wscript.Shell")
        objShell.Run(strCommand), 1, True
        Wscript.Quit
End If
 
' Bind to Active Directory.
Set objRootLDAP = GetObject("LDAP://rootDSE")
 
' CONFIGURATION PARAMETERS FOR THE SCRIPT
strExcelFile = Replace(WScript.ScriptFullName, WScript.ScriptName, "") & "Users_Short.xls"
strOUPath = "OU=studenter," & objRootLDAP.Get("defaultNamingContext")
' 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(Replace(objExcel.ActiveSheet.Cells(intRow, "A").Value, ",", ""))
        strUserName = Trim(objExcel.ActiveSheet.Cells(intRow, "B").Value)
        strPassword = Trim(objExcel.ActiveSheet.Cells(intRow, "C").Value)
        strHomeDirectory = Trim(Replace(objExcel.ActiveSheet.Cells(intRow, "F").Value, "/", "\"))
        strprofileDirectory = Trim(Replace(objExcel.ActiveSheet.Cells(intRow, "G").Value, "/", "\"))
        strOffice = Trim(Replace(objExcel.ActiveSheet.Cells(intRow, "D").Value, "/", "\"))
        strphone = Trim(Replace(objExcel.ActiveSheet.Cells(intRow, "E").Value, "/", "\"))
       
        strFirstName = Trim(left(strFullName, InStrRev(strFullName, " ") - 1))
        strLastName = Trim(left(strFullName, InStrRev(strFullName, " ") + 1))
             
        If strFullName <> "" And strUserName <> "" Then
           
                'WScript.Echo "About to create:" & VbCrLf &_
                '      strFullName & VbCrLf &_
                '      strFirstName & VbCrLf &_
                '      strLastName & VbCrLf & _
                '      strUserName & VbCrLf &_
                '      strPassword & VbCrLf &_
            '      strprofileDirectory & VbCrLf &_                
             '      strHomeDirectory & VbCrLf &_
                '      strOffice & VbCrLf &_
                '      strphone & 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= " & strusername)
                        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 "profilePath", strprofiledirectory & strUserName                  
                        objNewUser.SetInfo                    
                        objNewUser.Put "homeDrive", "H:"                        
                        objNewUser.Put "homeDirectory", strHomeDirectory & strUserName
                  objNewUser.SetInfo                        
                  objNewUser.Put "streetAddress", "Student"
                  objNewUser.Put "physicalDeliveryOfficeName", strOffice                        
                        objNewUser.Put "Telephonenumber", strPhone                  
                        objNewUser.Put "description", strFullname                  
                  objNewUser.SetPassword strPassword
                  objNewUser.Put "mail", strusername & "@student.hih.no"                        
                  objNewUser.Put "company", "HIH"                  
                  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
                End If
        End If
Next
 
WScript.Echo "Done"
objExcel.ActiveWorkbook.Close False
objExcel.Quit
Set objExcel = Nothing
0
stiana
Asked:
stiana
  • 2
2 Solutions
 
GundogTrainerCommented:
I have edited your script based on what you have stated.

I have commented the blocks that define what settings are applied to only new users or all the users so there may be some settings that you want to move but you should get the idea.
If LCase(Right(Wscript.FullName, 11)) = "wscript.exe" Then
        strPath = Wscript.ScriptFullName
        strCommand = "%comspec% /k cscript  """ & strPath & """"
        Set objShell = CreateObject("Wscript.Shell")
        objShell.Run(strCommand), 1, True
        Wscript.Quit
End If
 
' Bind to Active Directory.
Set objRootLDAP = GetObject("LDAP://rootDSE")
 
' CONFIGURATION PARAMETERS FOR THE SCRIPT
strExcelFile = Replace(WScript.ScriptFullName, WScript.ScriptName, "") & "Users_Short.xls"
strOUPath = "OU=studenter," & objRootLDAP.Get("defaultNamingContext")
' 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(Replace(objExcel.ActiveSheet.Cells(intRow, "A").Value, ",", ""))
        strUserName = Trim(objExcel.ActiveSheet.Cells(intRow, "B").Value)
        strPassword = Trim(objExcel.ActiveSheet.Cells(intRow, "C").Value)
        strHomeDirectory = Trim(Replace(objExcel.ActiveSheet.Cells(intRow, "F").Value, "/", "\"))
        strprofileDirectory = Trim(Replace(objExcel.ActiveSheet.Cells(intRow, "G").Value, "/", "\"))
        strOffice = Trim(Replace(objExcel.ActiveSheet.Cells(intRow, "D").Value, "/", "\"))
        strphone = Trim(Replace(objExcel.ActiveSheet.Cells(intRow, "E").Value, "/", "\"))
        
        strFirstName = Trim(left(strFullName, InStrRev(strFullName, " ") - 1))
        strLastName = Trim(left(strFullName, InStrRev(strFullName, " ") + 1))
              
        If strFullName <> "" And strUserName <> "" Then
            
                'WScript.Echo "About to create:" & VbCrLf &_
                '      strFullName & VbCrLf &_
                '      strFirstName & VbCrLf &_
                '      strLastName & VbCrLf & _
                '      strUserName & VbCrLf &_
                '      strPassword & VbCrLf &_
            '      strprofileDirectory & VbCrLf &_                
             '      strHomeDirectory & VbCrLf &_
                '      strOffice & VbCrLf &_
                '      strphone & 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

                        'Settings for New users only go in here
                        ' Build the actual User.
                        ' Attributes listed here: http://support.microsoft.com/kb/555638
                        Set objNewUser = objContainer.Create("User", "cn= " & strusername)
                        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.SetInfo
                        objNewUser.Put "mail", strusername & "@student.hih.no"                        
                        objNewUser.Put "company", "HIH"                  
                        objNewUser.AccountDisabled = False
                        objNewUser.SetPassword strPassword
                        objNewUser.SetInfo
                        'End of new user settings

                end if

                'Settings for Existing and new users are set here

                objNewUser.Put "givenName", strFirstName
                objNewUser.Put "sn", strLastName
                objNewUser.Put "displayName", strFullname
                objNewUser.Put "profilePath", strprofiledirectory & strUserName                  
                objNewUser.Put "homeDrive", "H:"                        
                objNewUser.Put "homeDirectory", strHomeDirectory & strUserName
                objNewUser.SetInfo
                objNewUser.Put "streetAddress", "Student"
                objNewUser.Put "physicalDeliveryOfficeName", strOffice                        
                objNewUser.Put "Telephonenumber", strPhone                  
                objNewUser.Put "description", strFullname                  
                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 of all user settings
                End If
                
        End If
Next
 
WScript.Echo "Done"
objExcel.ActiveWorkbook.Close False
objExcel.Quit
Set objExcel = Nothing

Open in new window

0
 
GundogTrainerCommented:
I forgot to comment out or remove line 61 that tells you the user exists already.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

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