Update ADS from excel. Need an addition.
Hi,
This script is from Rob which updates data from excel to ADS individual fields
At present it updates data in NOTES as :
Machine Name : xyz (Colum Q data)
Location : Abc (Colum B Data)
What i want now is now to add the serial no from colum "T" in excel
Serial No : zxy (Colum T Data)
So the final data in the Notes has to be as.
Machine Name : xyz (Colum Q data)
Location : Abc (Colum B Data)
Serial No : zxy (Colum T Data)
Regards
Sharath
This script is from Rob which updates data from excel to ADS individual fields
At present it updates data in NOTES as :
Machine Name : xyz (Colum Q data)
Location : Abc (Colum B Data)
What i want now is now to add the serial no from colum "T" in excel
Serial No : zxy (Colum T Data)
So the final data in the Notes has to be as.
Machine Name : xyz (Colum Q data)
Location : Abc (Colum B Data)
Serial No : zxy (Colum T Data)
Regards
Sharath
Sub Update_Seat_And_Extension_In_AD_From_Excel()
Application.EnableEvents = False
Const ADS_PROPERTY_CLEAR = 1
For intRow = 2 To Cells(65536, "L").End(xlUp).Row
strNTLogin = Trim(Cells(intRow, "L").Value)
If strNTLogin <> "" Then
strSeatNo = Trim(Cells(intRow, "B").Value)
strBuilding = Trim(Cells(intRow, "C").Value)
strExt = Trim(Cells(intRow, "D").Value)
strDepartment = Trim(Cells(intRow, "H").Value)
strTitle = Trim(Cells(intRow, "J").Value)
strMachine = Trim(Cells(intRow, "Q").Value)
strManager = Trim(Cells(intRow, "BI").Value)
If strManager <> "" Then
strManagerDN = Get_LDAP_User_Properties("user", "name", strManager, "distinguishedName")
Else
strManagerDN = ""
End If
If InStr(strManagerDN, "^") > 0 Then strManagerDN = Split(strManagerDN, "^")(1)
strADsPath = Get_LDAP_User_Properties("user", "samAccountName", strNTLogin, "adsPath")
If InStr(strADsPath, "^") > 0 Then strADsPath = Split(strADsPath, "^")(1)
If InStr(strADsPath, "LDAP://") > 0 Then
Set objUser = GetObject(strADsPath)
boolChanged = False
If UCase(objUser.physicalDeliveryOfficeName) <> UCase(strBuilding) Then
With Cells(intRow, "C").Interior
.ColorIndex = 36
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
boolChanged = True
If strSeatNo <> "" Then
objUser.physicalDeliveryOfficeName = UCase(strBuilding)
Else
objUser.PutEx ADS_PROPERTY_CLEAR, "physicalDeliveryOfficeName", 0
End If
End If
If UCase(objUser.telephoneNumber) <> UCase("Ext:" & strExt & " (044-3099" & strExt & ")") Then
With Cells(intRow, "D").Interior
.ColorIndex = 36
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
boolChanged = True
If strExt <> "" Then
objUser.telephoneNumber = UCase("Ext:" & strExt & " (044-3099" & strExt & ")")
Else
objUser.PutEx ADS_PROPERTY_CLEAR, "telephoneNumber", 0
End If
End If
If UCase(objUser.Department) <> UCase(strDepartment) Then
With Cells(intRow, "H").Interior
.ColorIndex = 36
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
boolChanged = True
If strDepartment <> "" Then
objUser.Department = strDepartment
Else
objUser.PutEx ADS_PROPERTY_CLEAR, "department", 0
End If
End If
If UCase(objUser.Title) <> UCase(strTitle) Then
With Cells(intRow, "J").Interior
.ColorIndex = 36
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
boolChanged = True
If strTitle <> "" Then
objUser.Title = strTitle
Else
objUser.PutEx ADS_PROPERTY_CLEAR, "title", 0
End If
End If
strNotesText = "Machine Name : " & strMachine & vbCrLf & "Location : " & strSeatNo
If UCase(objUser.Info) <> UCase(strNotesText) Then
With Cells(intRow, "B").Interior
.ColorIndex = 36
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
With Cells(intRow, "Q").Interior
.ColorIndex = 36
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
boolChanged = True
If strMachine <> "" Then
objUser.Info = UCase(strNotesText)
Else
objUser.PutEx ADS_PROPERTY_CLEAR, "info", 0
End If
End If
If InStr(strManagerDN, "CN=") > 0 Then
If objUser.Manager <> "" Then
If UCase(Mid(Left(objUser.Manager, InStr(objUser.Manager, ",") - 1), 4)) <> UCase(strManager) Then
With Cells(intRow, "BI").Interior
.ColorIndex = 36
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
boolChanged = True
objUser.PutEx ADS_PROPERTY_CLEAR, "Manager", 0
objUser.SetInfo
objUser.Manager = strManagerDN
End If
Else
With Cells(intRow, "BI").Interior
.ColorIndex = 36
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
boolChanged = True
objUser.Manager = strManagerDN
End If
ElseIf objUser.Manager <> "" Then
' Clear the Manager
With Cells(intRow, "BI").Interior
.ColorIndex = 36
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
boolChanged = True
objUser.PutEx ADS_PROPERTY_CLEAR, "Manager", 0
End If
If boolChanged = True Then
objUser.SetInfo
End If
Set objUser = Nothing
End If
End If
Next
Application.EnableEvents = True
End Sub
Function Get_LDAP_User_Properties(strObjectType, strSearchField, strObjectToGet, strCommaDelimProps)
If InStr(strObjectToGet, "\") > 0 Then
arrGroupBits = Split(strObjectToGet, "\")
strDC = arrGroupBits(0)
strDNSDomain = strDC & "/" & "DC=" & Replace(Mid(strDC, InStr(strDC, ".") + 1), ".", ",DC=")
strObjectToGet = arrGroupBits(1)
Else
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
End If
strDetails = ""
strBase = "<LDAP://" & strDNSDomain & ">"
' Setup ADO objects.
Set adoCommand = CreateObject("ADODB.Command")
Set ADOConnection = CreateObject("ADODB.Connection")
ADOConnection.Provider = "ADsDSOObject"
ADOConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = ADOConnection
' Filter on user objects.
'strFilter = "(&(objectCategory=person)(objectClass=user))"
strFilter = "(&(objectClass=" & strObjectType & ")(" & strSearchField & "=" & strObjectToGet & "))"
' Comma delimited list of attribute values to retrieve.
strAttributes = strCommaDelimProps
arrProperties = Split(strCommaDelimProps, ",")
' Construct the LDAP syntax query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False
' Run the query.
Set adoRecordset = adoCommand.Execute
' Enumerate the resulting recordset.
Do Until adoRecordset.EOF
' Retrieve values and display.
For intCount = LBound(arrProperties) To UBound(arrProperties)
If strDetails = "" Then
If IsArray(adoRecordset.Fields(intCount)) = False Then
strDetails = adoRecordset.Fields(intCount).Name & "^" & adoRecordset.Fields(intCount).Value
Else
strDetails = adoRecordset.Fields(intCount).Name & "^" & Join(adoRecordset.Fields(intCount).Value)
End If
Else
If IsArray(adoRecordset.Fields(intCount)) = False Then
strDetails = strDetails & "|" & adoRecordset.Fields(intCount).Name & "^" & adoRecordset.Fields(intCount).Value
Else
strDetails = strDetails & "|" & adoRecordset.Fields(intCount).Name & "^" & Join(adoRecordset.Fields(intCount).Value)
End If
End If
Next
' Move to the next record in the recordset.
adoRecordset.MoveNext
Loop
' Clean up.
adoRecordset.Close
ADOConnection.Close
Get_LDAP_User_Properties = strDetails
End Function
ASKER
Thank U...
Forgot to mention when there is a change thats updated in from the excel to the ADS it colors the cell to yellow. Can the change in the colum T also change to yellow when there is a change updated to the noted please
Forgot to mention when there is a change thats updated in from the excel to the ADS it colors the cell to yellow. Can the change in the colum T also change to yellow when there is a change updated to the noted please
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Thank U Matthew...
ASKER
ASKER
Sharath,
Posted to first, not too sure about the second I'm afraid!
Posted to first, not too sure about the second I'm afraid!
ASKER
Thank U
Matthew
Open in new window