Script to read a excel file and update active directory from it.

I have a spread sheet that has account names listed in column A and a number in Column B.  I'm trying to find a script that will update the AD account in Column A with the number in Column B to the employee attribute field in Active directory for that specific account, and then have it write in column C if it was able to complete the upload for each account or not.
LVL 4
seaninmanAsked:
Who is Participating?
 
Justin EllenbeckerConnect With a Mentor IT DirectorCommented:
The second one I put up added a leading 0, as far as the 99% I am looking at why its doing that on my machine it runs minimal.  Here it is after I did some more tweaking and watched the CPU usage on mine.  Ok this ran with about 5 records in a test file for me in a few seconds the C:\results.csv gets written out as soon as the first record is done and then it keeps going from there.  I noticed I ran into a looping error which caused the CPU to spike on mine as well and that is all taken care of.  Let me know if this works for you and writes out the data, it does have the leading zero now and but that will not show on the results.
On Error Resume Next

Set oFS = CreateObject("Scripting.FileSystemObject")
Set oConn = CreateObject("ADODB.Connection")
Set oComm = CreateObject("ADODB.Command")
oConn.Provider = "ADsDSOObject"
oConn.open "Active Directory Provider"
Set oComm.ActiveConnection = oConn

srcFile = "C:\ADInput.csv"
ResultFile = "C:\Results.csv"

Set oFile = oFS.OpenTextFile(srcFile, 1, False)
Set results = oFS.OpenTextFile(ResultFile, 2, True)

'Comment out the following line if your data does not have headers
oFile.ReadLine

'Creates the header on the results CSV
results.WriteLine("Account,ID,Result")

Do While Not oFile.AtEndOfStream
	arrData = Split(oFile.ReadLine,",")
	oComm.CommandText = "Select adspath from 'LDAP://DC=mydomain,DC=local' WHERE objectCategory='user' AND SAMAccountName='" & arrdata(0) & "'"
	Set oRS = oComm.Execute
	If oRS.RecordCount > 0 Then
		oRS.MoveFirst
		Do Until oRS.EOF
			ldp = oRS.Fields("ADSPath").Value
			Set oUser = GetObject(ldp)
			oUser.EmployeeID = "0" & arrdata(1)
			If Err.Number <> 0 Then
				results.WriteLine(arrdata(0) & "," & arrdata(1) & ",Fail")
			Else
				results.WriteLine(arrdata(0) & "," & arrdata(1) & ",Success")
			End If
			Err.Clear
			oRS.movenext
		Loop
	Else 
		results.WriteLine(arrdata(0) & "," & arrdata(1) & ",User Not Found")
	End If
Loop

Open in new window

0
 
Justin EllenbeckerIT DirectorCommented:
I am putting something together and just have a couple quick questions.  Are all of the users in the same OU?  Since Excel can open CSVs do you mind if i write it for CSVs and then you can just save the sheet as a CSV with name the script is looking for?
0
 
Justin EllenbeckerIT DirectorCommented:
Here is what I have so far it will read in the account name field and process from the two csv files as long as all of the users are in the same OU.  It will create a second CSV with the results and headers that can easily be opened in excel.  You will need to change the LDAP query to match your AD structure.  Also if you want to change files names that is very easy as well.
On Error Resume Next

Set oFS = CreateObject("Scripting.FileSystemObject")

srcFile = "C:\ADInput.csv"
ResultFile = "C:\Results.csv"

Set oFile = oFS.OpenTextFile(srcFile, 1, False)
Set results = oFS.OpenTextFile(ResultFile, 2, True)

'Comment out the following line if your data does not have headers
oFile.ReadLine

'Creates the header on the results CSV
results.WriteLine("Account,ID,Result")

Do While Not oFile.AtEndOfStream
	arrData = Split(oFile.ReadLine,",")
	Set oUser = GetObject("LDAP://cn=" & arrdata(0) & ",ou=OrgUnit,dc=My,dc=Domain")
	oUser.EmployeeID = arrdata(1)
	If Err.Number <> 0 Then
		results.WriteLine(arrdata(0) & "," & arrdata(1) & ",Fail")
	Else
		results.WriteLine(arrdata(0) & "," & arrdata(1) & ",Success")
	End If
	Err.Clear
Loop

Open in new window

0
Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
Justin EllenbeckerIT DirectorCommented:
The CN I am looking for is the Common Name for the user in this example such as "John Smith".  Since I wasn't sure what you have in the actual file for the names.
0
 
seaninmanAuthor Commented:
Trying to run it, but it says it fails in the results page.  you think we can add some pop ups on where its failing?
0
 
seaninmanAuthor Commented:
I bet it has to do with the common name.  I am actually using the user logon ID.
0
 
jostranderCommented:
Here's a macro I wrote that works for me:
Sub ProcessUserList()
 
    strAttribute = "employeeID"
 
    intRow = 2  '2 if there are headings, 1 if none
   
    Do Until Cells(intRow, 1).Value = ""
        strUser = Cells(intRow, 1)
        strValue = CStr(Cells(intRow, 2))
        If strUser <> "" Then
            test = SetAttribute(strUser, strAttribute, strValue)
            Cells(intRow, 3) = test
        
        End If
        intRow = intRow + 1
    Loop
End Sub
    
Function SetAttribute(myUser, myAttribute, myValue)

    On Error Resume Next

    Const ADS_SCOPE_SUBTREE = 2

    Set objRootDSE = GetObject("LDAP://rootDSE")
    strAdspath = "LDAP://" & objRootDSE.Get("defaultNamingContext")
    
    Set objConnection = CreateObject("ADODB.Connection")
    Set objCommand = CreateObject("ADODB.Command")
    objConnection.Provider = "ADsDSOObject"
    objConnection.Open "Active Directory Provider"
    Set objCommand.ActiveConnection = objConnection
    
    objCommand.Properties("Page Size") = 1000
    objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
    
    objCommand.CommandText = _
        "SELECT ADsPath FROM '" & strAdspath & "' WHERE objectCategory='User' " & _
            "AND samaccountname='" & myUser & "' "
    
    Set objRecordSet = objCommand.Execute
    
    objRecordSet.MoveFirst
    
    strAdspath = objRecordSet.Fields("ADsPath").Value
    
    Set objUser = GetObject(strAdspath)

    CurrentVal = objUser.Get(myAttribute)

    If CurrentVal = myValue Then
        SetAttribute = "ALREADY SET"
    Else
        objUser.Put myAttribute, myValue
        objUser.SetInfo
    
        If Err.Number = 0 Then
            SetAttribute = "SUCCESS"
        Else
            SetAttribute = "FAILED"
        End If
    
    End If
End Function

Open in new window

0
 
seaninmanAuthor Commented:
I am trying the macro jostrander and its still writing failed in column C.  Can we also update so that it writes a leading 0 for all the employee id's?

I have the account logon id in column A
0
 
Justin EllenbeckerIT DirectorCommented:
This may be simialr but I rewrote it with ADODB instead since you are using the samaccount name .  Everything else will be the same except the output file will now contain the line: "User Not Found" if that is the case.  If everything is failing it was probably the CN that was causing it this new script will runn through all of the AD and find the User no matter what OU they are in.
On Error Resume Next

Set oFS = CreateObject("Scripting.FileSystemObject")
Set oConn = CreateObject("ADODB.Connection")
Set oComm = CreateObject("ADODB.Command")
oConn.Provider = "ADsDSOObject"
oConn.open "Active Directory Provider"
Set oComm.ActiveConnection = oConn

srcFile = "C:\ADInput.csv"
ResultFile = "C:\Results.csv"

Set oFile = oFS.OpenTextFile(srcFile, 1, False)
Set results = oFS.OpenTextFile(ResultFile, 2, True)

'Comment out the following line if your data does not have headers
oFile.ReadLine

'Creates the header on the results CSV
results.WriteLine("Account,ID,Result")

Do While Not oFile.AtEndOfStream
	arrData = Split(oFile.ReadLine,",")
	oComm.CommandText = "Select adspath from 'LDAP://DC=mydomain,DC=local' WHERE objectCategory='user' AND SAMAccountName='" & arrdata(0) & "'"
	Set oRS = oComm.Execute
	If oRS.RecordCount > 0 Then
		oRS.MoveFirst
		Do Until oRS.EOF
			ldp = oRS.Fields("ADSPath").Value
			Set oUser = GetObject(ldp)
			oUser.EmployeeID = arrdata(1)
			If Err.Number <> 0 Then
				results.WriteLine(arrdata(0) & "," & arrdata(1) & ",Fail")
			Else
				results.WriteLine(arrdata(0) & "," & arrdata(1) & ",Success")
			End If
			Err.Clear
			oRS.movenext
		Loop
	Else 
		results.WriteLine(arrdata(0) & "," & arrdata(1) & ",User Not Found")
	End If
Loop

Open in new window

0
 
Justin EllenbeckerIT DirectorCommented:
The last one I posted doesn't have the leading 0 for the ID this one does.  It should go through I was running some echoes against my ID for my username without actually changing anything obviously, I also used a user that is unknown.  Again mine are based off a CSV I like working with them a little more than excel so especially if a system doesn't have excel installed I can still run scripts like this.  Make sure you replace the proper lines and comment out the line if your CSV does not have a header row.
On Error Resume Next

Set oFS = CreateObject("Scripting.FileSystemObject")
Set oConn = CreateObject("ADODB.Connection")
Set oComm = CreateObject("ADODB.Command")
oConn.Provider = "ADsDSOObject"
oConn.open "Active Directory Provider"
Set oComm.ActiveConnection = oConn

srcFile = "C:\ADInput.csv"
ResultFile = "C:\Results.csv"

Set oFile = oFS.OpenTextFile(srcFile, 1, False)
Set results = oFS.OpenTextFile(ResultFile, 2, True)

'Comment out the following line if your data does not have headers
oFile.ReadLine

'Creates the header on the results CSV
results.WriteLine("Account,ID,Result")

Do While Not oFile.AtEndOfStream
	arrData = Split(oFile.ReadLine,",")
	oComm.CommandText = "Select adspath from 'LDAP://DC=mydomain,DC=local' WHERE objectCategory='user' AND SAMAccountName='" & arrdata(0) & "'"
	Set oRS = oComm.Execute
	If oRS.RecordCount > 0 Then
		oRS.MoveFirst
		Do Until oRS.EOF
			ldp = oRS.Fields("ADSPath").Value
			Set oUser = GetObject(ldp)
			oUser.EmployeeID = "0" & arrdata(1)
			If Err.Number <> 0 Then
				results.WriteLine(arrdata(0) & "," & arrdata(1) & ",Fail")
			Else
				results.WriteLine(arrdata(0) & "," & arrdata(1) & ",Success")
			End If
			Err.Clear
			oRS.movenext
		Loop
	Else 
		results.WriteLine(arrdata(0) & "," & arrdata(1) & ",User Not Found")
	End If
Loop

Open in new window

0
 
seaninmanAuthor Commented:
Okay StrifeJester the script worked.  Can you update it so that it will add a zero 0 leading the employee id?  So if employee id on the csf file = 123456 it inputs 0123456 in the employee id attribute field.
0
 
seaninmanAuthor Commented:
One more thing..  I noticed it updated in AD but the script was still occupying 99% CPU and running, it didnt create the results.csv either before i stopped it.
0
 
jostranderCommented:
Could you post a sample of your XLS?  

In my testing, I have data like this:

Username      Employee ID      Status
testuser1      abcd1234      ALREADY SET
testuser2      1234567      SUCCESS
testuser3      abcd7896      ALREADY SET
0
 
jostranderCommented:
Nevermind, sounds like you have a working solution... good job StrifeJester

0
 
jostranderCommented:
If you're still interested in the macro, this should add text to say why it failed for your test (I'm a bit curious).

It's possible that it set the values, but said failed for some other reason.

Thanks,
Joe



Sub ProcessUserList()
 
    strAttribute = "employeeID"
    strPrefix = "0"
 
 
    intRow = 2  '2 if there are headings, 1 if none
   
    Do Until Cells(intRow, 1).Value = ""
        strUser = Cells(intRow, 1)
        strValue = strPrefix & Cells(intRow, 2)
        
        If strUser <> "" And strValue <> "" Then
            test = SetAttribute(strUser, strAttribute, strValue)
            Cells(intRow, 3) = test
        
        End If
        intRow = intRow + 1
        strUser = ""
        strValue = ""
    Loop
    
    Cells.EntireColumn.AutoFit
    
End Sub
    
Function SetAttribute(myUser, myAttribute, myValue)

    On Error Resume Next

    Const ADS_SCOPE_SUBTREE = 2

    Set objRootDSE = GetObject("LDAP://rootDSE")
    strAdspath = "LDAP://" & objRootDSE.Get("defaultNamingContext")
    
    Set objConnection = CreateObject("ADODB.Connection")
    Set objCommand = CreateObject("ADODB.Command")
    objConnection.Provider = "ADsDSOObject"
    objConnection.Open "Active Directory Provider"
    Set objCommand.ActiveConnection = objConnection
    
    objCommand.Properties("Page Size") = 1000
    objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
    
    objCommand.CommandText = _
        "SELECT ADsPath FROM '" & strAdspath & "' WHERE objectCategory='User' " & _
            "AND samaccountname='" & myUser & "' "
    
    Set objRecordSet = objCommand.Execute
    
    objRecordSet.MoveFirst
    
    strAdspath = objRecordSet.Fields("ADsPath").Value
    
    Set objUser = GetObject(strAdspath)

    CurrentVal = objUser.Get(myAttribute)

    If CurrentVal = myValue Then
        SetAttribute = "ALREADY SET"
    Else
        objUser.Put myAttribute, myValue
        objUser.SetInfo
    
        If Err.Number <> 0 Then
            SetAttribute = "FAILED (" & Err.Number & " - " & Err.Description & ")"
        Else
            SetAttribute = "SUCCESS"
        End If
    
    End If
End Function

Open in new window

0
 
Justin EllenbeckerIT DirectorCommented:
You may notice that is the identicval code, i reposted it and forgot the other changes that matter if this is running on vista,server 2008 or windows 7 you cannot write to C:\  programmatically.  You will need to make it a UNC share or some other path.  the UAC in the newer OS stops it.
0
 
itdle0Commented:
Script doesn't even update the account in active directory with the employee id.
0
All Courses

From novice to tech pro — start learning today.