vbscript: Import User attributes in AD from Excel – using CNs

Dim arrCNs()
Dim arrAttribs()
Dim arrValues()
Set fso = CreateObject("Scripting.FileSystemObject")
set objArgs = WScript.Arguments

'*** Usage ***
If WScript.Arguments.Count <> 1 Then
Usage
ElseIf objArgs(0) = "/?" Then
Usage
Else
ExcelFileName = objArgs(0)
End If

'*** If no path given assume current folder ***
If InStr(ExcelFileName, "\") = 0 Then
ExcelFileName = fso.GetAbsolutePathName("") & "\" & ExcelFileName
End If

'*** Populate arrays from spreadsheet ***
GetColumn arrCNs, ExcelFileName, 1
GetColumn arrAttribs, ExcelFileName, 2
GetColumn arrValues, ExcelFileName, 3

'*** Check column lengths ***
If Ubound(arrCNs) <> Ubound(arrAttribs) Or Ubound(arrCNs) <> Ubound(arrValues) Then
ErrorHandler("Column lengths are uneven")
End If

'*** Loop through the CNs, setting attribute values ***
For i = 0 To Ubound(arrCNs)
If FindDN(arrCNs(i), userDN) = 1 Then
UpdateAttrib userDN, arrCNs(i), arrAttribs(i), arrValues(i)
End If
Next

'************************************************************************************
' SUBROUTINES
'************************************************************************************

Sub GetColumn(arrExcelValues,ExcelFileName,n)

Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open(ExcelFileName)
objExcel.Visible = True

i = 1
x = 0

Do Until objExcel.Cells(i, n).Value = ""
ReDim Preserve arrExcelValues(x)
arrExcelValues(x) = objExcel.Cells(i, n).Value
i = i + 1
x = x + 1
Loop

objExcel.Quit

End Sub

Function FindDN(CN, DN)

On Error Resume Next
Const ADS_SCOPE_SUBTREE = 2

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 'LDAP://dc=fabrikam,dc=com' WHERE objectClass='user'"_
& " AND Name='" & CN & "'"
Set objRecordSet = objCommand.Execute

If objRecordSet.RecordCount = 0 Then
wscript.echo CN & " not found"
FindDN = 0
ElseIf objRecordSet.RecordCount > 1 Then
wscript.echo "More than one user object found with the name " & CN
FindDN = 0
Else
FindDN = 1
objRecordSet.MoveFirst
DN = objRecordSet.Fields("AdsPath").Value
End If
End Function

Sub UpdateAttrib(DN, CN, attrib, value)
On Error Resume Next

Set objUser = GetObject(DN)

If objUser.Name="" Then
wscript.echo DN & " not found"
Else
objUser.Put attrib, value
objUser.SetInfo
Set objUser = GetObject(DN)
If objUser.Get(attrib) = value Then
wscript.echo CN & ", " & attrib & " successfully updated."
End If
End If

End Sub

Sub Usage
wscript.echo
wscript.echo "This script imports values from an Excel spreadsheet into AD."
wscript.echo
wscript.echo "It will OVERWRITE the current value, "
wscript.echo "and must be used for SINGLE-VALUED attributes only."
wscript.echo
wscript.echo "usage: cscript import2AD spreadsheet"
wscript.echo
wscript.echo "The spreadsheet must have THREE columns, in the following configuration:"
wscript.echo "Column 1: Object CN"
wscript.echo "Column 2: Attribute Name"
wscript.echo "Column 3: New Value"
wscript.echo
wscript.echo "The spreadsheet should not have blank rows or column headings."
WScript.Quit(0)
End Sub

Sub ErrorHandler(ErrorMessage)
wscript.echo "Error: " & ErrorMessage
WScript.Quit(1)
End Sub