Issue Scripting with Excel

[arohl74]

I have a script to modify Active Directory user information that uses Excel as the source of the information.

The username is in ColumnA, the property information is in ColumnB and ColumnC. The script takes the username in the spreadsheet to find the DN and then modifies AD based on the information in Columns B and C.

I get errors that state the DN cannot be found based on Column A unles I retype the text in the cells in Column A.

Has anyone seen this? Does anyone have a script that can automate retyping the information in column A?

 

[markdmac]

Retyping the text is not needed, there is something else wrong with your code. Post your script if you want assistance.

I hope you find this post helpful.

Regards,

Mark

Check out my scripting solutions at

http://www.thespidersparlor.com/vbscript

Work SMARTER not HARDER. The Spider's Parlor's Admin Script Pack is a collection of Administrative scripts designed to make IT Administration easier! Save time, get more work done, get the Admin Script Pack.

 

[arohl74]

The script works but only after I retype the names in the spreadsheet. Here is the code:

Option Explicit

On Error Resume Next

'=== Constants Required for OpenTextFile function
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8


'=== Retrieve command line parameters
Dim oArgs
Set oArgs = Wscript.Arguments

If oArgs.Count < 3 Then
'=== Incorrect number of parameters
ShowSyntax
End If

Dim infile, outfile, basedn, verbose
Dim argscol
Set argscol = WScript.Arguments.Named
If Not argscol.Exists("i") Then
'=== Missing input file
ShowSyntax
Else
infile = argscol.Item("i")
End If

If Not argscol.Exists("o") Then
'=== Missing output file
ShowSyntax
Else
outfile = argscol.Item("o")
End If

If Not argscol.Exists("basedn") Then
'=== Missing basedn file
ShowSyntax
Else
basedn = argscol.Item("basedn")
End If

If argscol.Exists("v") Then
If LCase(argscol.Item("v")) = "yes" Then
verbose = true
Else
verbose = false
End If
Else
verbose = false
End If


'=== Bind to RootDSE and keep a reference to avoid binding again
' for later calls
Dim dso
Set dso = GetObject("LDAP://RootDSE")
IF Err.Number <> 0 Then
WScript.Echo "Unable to bind to: " & "LDAP://RootDSE"
WScript.Quit 1
End If

'=== Open up the outputfile for write access
Dim fs,fsOut
Set fs = CreateObject("Scripting.FileSystemObject")
Set fsOut = fs.OpenTextFile(outfile, ForWriting, True)

'=== Open up the input file in Excel (hidden)
Dim appExcel, workbook, range
Set appExcel = CreateObject("Excel.Application")
Err.Clear
Set workbook = appExcel.WorkBooks.open(infile)
If Err.Number <> 0 Then
appExcel.Quit
ShowSyntax
End If
appExcel.visible = false
workbook.activate

'=== Select the entire region where data exists
Set range = appExcel.ActiveCell.CurrentRegion

'=== Store the attribute names in the attributes array
' Attributes names are the column headers specified
' in the first row of the CSV file or spreadsheet
Dim attributeNames()
ReDim Preserve attributeNames(range.Columns.count)
Dim i
For i = 0 to range.Columns.count - 1
attributeNames(i) = range.cells(1,i+1).value
Next


'=== These counters will keep track of the script's
' progress so it can be displayed in the summary
' at the end
Dim numUpdatedObjects, numUpdatedAttribs, numErrors, numObjects
numUpdatedObjects = 0
numUpdatedAttribs = 0
numErrors = 0
numObjects = 0

Dim username, changeMade
'=== Process each row of data
For i = 2 to range.Rows.Count
Dim numUpdates
Dim outputString

'=== reset the counter for the number of updates
' made for this object
numUpdates = 0
outputString = ""
numObjects = numObjects + 1

Err.Clear
changeMade = False

'=== Get the DN value for the object we need to modify from
' the spreadsheet (this assumes that the first column
' contains the username - sAMAccountName)
username = range.cells(i,1).value

'=== Set up ADs Provider to query DN for specified username
Dim ADConn
Set ADConn = CreateObject("ADODB.Connection")
ADConn.Provider = "ADSDSOObject"
ADConn.Open "ADs Provider"

'=== Find the DN of the username provided
Dim query
query = "<LDAP://" & basedn & ">;(&(objectclass=user)(sAMAccountName=" & _
username & "));distinguishedName;subtree"
Dim ADrs
Set ADrs = ADConn.Execute(cstr(query))
If NOT ADrs.EOF Then
Dim dn
dn = ADrs("distinguishedName").Value
Err.Clear

If verbose = true Then
WScript.Echo "Connecting to: " & dn
End If


'=== Get reference to object
Dim ADObject
Set ADObject = GetObject("LDAP://" & dn)

If Err.Number <> 0 Then
'=== Unsuccessful, object does not exist in the given path
If verbose = true Then
WScript.Echo "ERROR: " & username & " (" & dn & ")" & " does not exist!"
End If
fsOut.WriteLine "ERROR: " & username & " (" & dn & ")" & " does not exist!"
numErrors = numErrors + 1
Else
'=== Bind successful, object exists
Dim j
For j = 1 to range.Columns.Count - 1
Dim attrValFromWkSht, attrVal
attrValFromWkSht = range.cells(i,j+1).value

Err.Clear
'=== Get value for each attribute
attrVal = ADObject.Get(attributeNames(j))
If Err.Number = 0 Then
'=== Check if the value in the speadsheet is different
' from the value in the Active Directory
If (LCase(CStr(attrValFromWkSht)) <> LCase(CStr(attrVal))) Then
'=== Update the value
ADObject.put attributeNames(j),CStr(attrValFromWkSht)
outputString = outputString & "UPDATED: " & username & " (" & dn & ")" & ": " & _
attributeNames(j) & " : from " & attrVal & " to " & attrValFromWkSht & vbCrLf
numUpdates = numUpdates + 1
changeMade = True
End If
Else
'=== The attribute does not have a value, update it
ADObject.put attributeNames(j),attrValFromWkSht
outputString = outputString & "UPDATED: " & username & " (" & dn & ")" & ": " & _
attributeNames(j) & " : from [blank] to " & attrValFromWkSht & vbCrLf
numUpdates = numUpdates + 1
changeMade = True
End If
Next

Err.Clear
If (changeMade = True) Then
'=== Commit the changes
ADObject.setInfo
If Err.Number = 0 Then
'=== All changes were successfully updated
If verbose = true Then
WScript.Echo "Updated " & numUpdates & " value(s) for " & username & " (" & dn & ")"
End If
numUpdatedObjects = numUpdatedObjects + 1
numUpdatedAttribs = numUpdatedAttribs + numUpdates
fsOut.Write outputString
Else
'=== Unable to commit changes, output error
If verbose = true Then
WScript.Echo "ERROR: failed to update " & username & " (" & dn & ")"
End If
fsOut.WriteLine "ERROR: failed to update " & username & " (" & dn & ")"
numErrors = numErrors + 1
End If
Else
fsOut.WriteLine "INFO: No Changes for " & username & " (" & dn & ")"
If verbose = true Then
WScript.Echo "INFO: No changes for " & username & " (" & dn & ")"
End If
End If
End If
Else
'=== Unable to determine the distinguishedName for the username provided
numErrors = numErrors + 1
fsOut.writeLine "ERROR: Unable to find DN for " & username
If verbose = true Then
WScript.Echo "ERROR: Unable to find DN for " & username
End If
End If
Next



'=== Output Summary
Dim summaryString
summaryString = vbCrLf & _
"Summary" & vbCrLf & _
"========================================================" & vbCrLf & _
"Processed Objects : " & numObjects & vbCrLf & _
"No. Updated Objects : " & numUpdatedObjects & vbCrLf & _
"No. Updated Attributes : " & numUpdatedAttribs & vbCrLf & _
"No. Errors : " & numErrors & vbCrLf & _
"========================================================" & vbCrLf
WScript.Echo summaryString
fsOut.WriteLine summaryString

'=== Cleanup
appExcel.Quit
set appExcel = nothing
fsOut.Close
set fsOut = nothing
set dso = nothing

'============================================================================
' Sub ShowSyntax
' Purpose: Show syntax for the script and example
'============================================================================
Sub ShowSyntax()
'=== User did not specify the required parameters, output syntax and quit
WScript.Echo "PURPOSE:"
WScript.Echo " Updates attributes for objects in Active Directory based on"
WScript.Echo " a CSV file or Excel Spreadsheet" & vbCrLf
Wscript.Echo "USAGE:"
WScript.Echo " updateattribs.vbs /i:inputfile /outputfile /basednC=COMPANY,DC=COM /v:yes" & vbCrLf
WScript.Echo " The /v switch specifies verbose output." & vbCrLf
WScript.Echo " You need to specify the full path to the input file and enclose" & vbCrLf & _
" it in quotes if there is a space in the path." & vbCrLf
Wscript.Echo "EXAMPLE:" & vbCrLf & " updateattribs /i:" & CHR(34) & "C:\updates.csv" & CHR(34) & _
" /o:results.txt /basednC=SCRIPTMATION,DC=COM"
Wscript.Quit 1
End Sub


Thanks!

 

[Ronster]

I would guess that the re-typing of the data in column A will cause excel to format the data into a certain type.
When the spreadsheet is opened from a csv this cell type might not be maintained.

You may be able to change the range attributes to cell type text.

Ronster
"If you’re too open-minded, your brains will fall out.