Excel update Active directory .Small changes are instead of colum B being updated i want colum C to be updated and colum B data has to be updated in the notes box.
Hi,
At present this excel macro updates the Seat no,Manager name, Machine name and extension.
Small changes are instead of colum B being updated i want colum C to be updated and colum B data has to be updated in the notes box.
Already there is machine name there. I need it to come below it as
Machine name : abc1234
Location : GWE-1F-090
Regards
Sharath
At present this excel macro updates the Seat no,Manager name, Machine name and extension.
Small changes are instead of colum B being updated i want colum C to be updated and colum B data has to be updated in the notes box.
Already there is machine name there. I need it to come below it as
Machine name : abc1234
Location : GWE-1F-090
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)
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(strSeatNo) Then
With Cells(intRow, "B").Interior
.ColorIndex = 36
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
boolChanged = True
If strSeatNo <> "" Then
objUser.physicalDeliveryOfficeName = UCase(strSeatNo)
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
If UCase(objUser.Info) <> UCase("Machine Name : " & strMachine) Then
With Cells(intRow, "Q").Interior
.ColorIndex = 36
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
boolChanged = True
If strMachine <> "" Then
objUser.Info = UCase("Machine Name : " & strMachine)
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
At present the machine names come into the Notes as
machine names : Colum Q data
Then i even want
Location : Colum D Data
So the notes will have
Machinename : Somename
Location : Some location
machine names : Colum Q data
Then i even want
Location : Colum D Data
So the notes will have
Machinename : Somename
Location : Some location
replace from line 81.
or do yiu need to change the prt where variables are assigned from cells right at the top also ?
or do yiu need to change the prt where variables are assigned from cells right at the top also ?
If UCase(objUser.Info) <> UCase("Machine Name : " & strMachine) Then
With Cells(intRow, "Q").Interior
.ColorIndex = 36
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
boolChanged = True
If strMachine <> "" Then
objUser.Info = UCase("Machine Name : " & strMachine) & vbcrlf & "Location : " & strExt '<<<<< update
Else
objUser.PutEx ADS_PROPERTY_CLEAR, "info", 0
End If
End If
Sharath....it's been a while since I looked at this one....can you please provide a sample XLS file so that I can see which columns have which data in it?
Rob.
Rob.
ASKER
Rob attached is a sample file
Sample.xls
Sample.xls
ASKER
Rob previously the seat no used to be updated so in that place i want the C colum Data.
And the B colum data has to get into the notes box.
So already i have the machine name in the notes box.
Machine Name : Pc name
Location : Seat No of colum B
And when some data is updated the cell has to be marked with yellow color.
And the B colum data has to get into the notes box.
So already i have the machine name in the notes box.
Machine Name : Pc name
Location : Seat No of colum B
And when some data is updated the cell has to be marked with yellow color.
ASKER
Hi Rob any help on this post
Hi Sharath, sorry for my delay, this should work for this one...
I've made Column C go to the physicalDeliveryOfficeName
Regards,
Rob.
I've made Column C go to the physicalDeliveryOfficeName
Regards,
Rob.
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, "B").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, "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
Thankls a lot Rob worked perfect. Can i get the changed data into yellow.
The colum B and C also
The colum B and C also
ASKER
Thankls a lot Rob worked perfect. Can i get the changed data into yellow.
The colum B and C also
The colum B and C also
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Thanks Rob...
today helped me on lot of posts :-)
How come you are working on a Saturday ?
today helped me on lot of posts :-)
How come you are working on a Saturday ?
No problem. It's 10:30 Saturday morning now....it was Friday afternoon (about 4pm) when I posted those comments yesterday.
Today I'm just quickly cleaning up my "Experts" tab of questions that I'm participating in....
Rob.
Today I'm just quickly cleaning up my "Experts" tab of questions that I'm participating in....
Rob.
ASKER
:-)
OK...
OK...
2/ where does the notes data come from. ? Is the data in the notes cell to be save to the AD notes field ?
need to post you spreadsheet or a portion of it...
Open in new window