''************************************************************************************
' import2AD.vbs
'
' usage: cscript import2AD.vbs excel_file
'
' This script reads a list of DNs, attributes and values from an Excel spreadsheet.
' It then modifies the DN in Active Directory - setting attribute = value
' Use on any object type, for single-valued attributes only
'
' Written by Carol Wapshere
' 18th December 2007
'
'************************************************************************************
Dim arrDNs()
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 arrDNs, ExcelFileName, 1
GetColumn arrAttribs, ExcelFileName, 2
GetColumn arrValues, ExcelFileName, 3
'*** Check column lengths, ignore first row if "CN=" not found ***
If Ubound(arrDNs) <> Ubound(arrAttribs) Or Ubound(arrDNs) <> Ubound(arrValues) Then
ErrorHandler("Column lengths are uneven")
End If
If UCase(Left(arrDNs(0),3)) = "CN=" Then
startrow = 0
Else
startrow = 1
End If
'*** Loop through the DNs, setting attribute values ***
For i = startrow To Ubound(arrDNs)
UpdateAttrib arrDNs(i), arrAttribs(i), arrValues(i)
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
Sub UpdateAttrib(DN, attrib, value)
On Error Resume Next
Set objUser = GetObject("LDAP://" & DN)
If objUser.Name="" Then
wscript.echo DN & " not found"
Else
objUser.Put attrib, value
objUser.SetInfo
Set objUser = GetObject("LDAP://" & DN)
If objUser.Get(attrib) = value Then
wscript.echo DN & " successfully updated attribute " & attrib
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 FQDN"
wscript.echo "Column 2: Attribute Name"
wscript.echo "Column 3: New Value"
wscript.echo
wscript.echo "The spreadsheet may or may not have column headings."
WScript.Quit(0)
End Sub
Sub ErrorHandler(ErrorMessage)
wscript.echo "Error: " & ErrorMessage
WScript.Quit(1)
End Sub