Update active directory from excel script need a change to update the Manager from any Domain.

bsharath
bsharath used Ask the Experts™
on
Hi,

Update active directory from excel script need a change to update the Manager from any Domain.
the code here is from Robsamson which works perfect and i use it daily basis as there is some change each day.

I have managers from different Domains that needs to be updated. i want help in being able to update the manager portion from any Domain in the forest and a way to mention the Domain path also in the Code.
So if the Default way fails i can mention the full DN path

Regards
Sharath
Sub Update_Seat()

'Active Directory
      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)
            strSerialNo = Trim(Cells(intRow, "T").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)
            strEmail = Trim(Cells(intRow, "O").Value)
            strEmpId = Trim(Cells(intRow, "E").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 strBuilding = "C" Then
                    strArea = " (04-7100"
                    strNewNumber = "Ext:" & strExt & strArea & ") (" & strSeatNo & ")"
                ElseIf strBuilding = "P" Then
                    strArea = " (04-300"
                    strNewNumber = "Ext:" & strExt & strArea & ") (" & strSeatNo & ")"
                Else
                    strArea = " (04-3"
                    strNewNumber = "Ext:" & strExt & strArea & strExt & ") (" & strSeatNo & ")"
                End If
                
                If UCase(objuser.telephoneNumber) <> UCase(strNewNumber) Then
                    With Cells(intRow, "D").Interior
                        .ColorIndex = 36
                        .Pattern = xlSolid
                        .PatternColorIndex = xlAutomatic
                    End With
                    boolChanged = True
                    If strExt <> "" Then
                        objuser.telephoneNumber = UCase(strNewNumber)
                    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 = "EMP ID : " & strEmpId & vbCrLf & "EMAIL ADDRESS : " & strEmail & vbCrLf & "Machine Name : " & strMachine & vbCrLf & "Location : " & strSeatNo & vbCrLf & "Serial Number : " & strSerialNo
                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
                    With Cells(intRow, "T").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

Open in new window

Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Most Valuable Expert 2012
Top Expert 2014

Commented:
Hi Sharath, I think the only way we *might* be able to achieve this is to use the Global Catalog (GC:// instead of LDAP://), but I'm not sure, as I only have one domain, and can't test it.

I will try to provide a small piece of code to test for one account next week.

Regards,

Rob.

Author

Commented:
Ok Rob Thanks...

Author

Commented:
There could be one issue.
Say Sharath with a username in Domain1 can also be in Domain 2
So search in Domain (Local) if not only then search other domains if match found add
Success in ‘20 With a Profitable Pricing Strategy

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden using our free interactive tool and use it to determine the right price for your IT services. Start calculating Now!

Most Valuable Expert 2012
Top Expert 2014

Commented:
Hi, if you run this, it should output the names of your DCs, and on which domain your Global Catalog is located.

If this shows correct details, we may be able to use these servers to find the accounts.....

Regards,

Rob.
'Source: http://cwashington.netreach.net/depo/view.asp?Index=1132&ScriptType=vbscript
'Original author: Jan Aarts 
'Modified by: Rob Sampson
If LCase(Right(Wscript.FullName, 11)) = "wscript.exe" Then
    strPath = Wscript.ScriptFullName
    strCommand = "%comspec% /k cscript  """ & strPath & """"
    Set objShell = CreateObject("Wscript.Shell")
    objShell.Run(strCommand), 1, True
    Wscript.Quit
End If

strAdminDN = InputBox("Enter forest administrator username (DOMAIN/Username):", "Forest Admin Username")
strPassword = InputBox("Enter forest administrator password:", "Admin Password")

Set Con = CreateObject("ADODB.Connection")
con.Provider = "ADsDSOObject"
con.Open "Active Directory Provider", strAdminDN, strPassword

Set gc = GetObject("GC:")
For Each child In gc
    Set entpr = child
Next

Domains = 0
TotalDomainDCs = 0

Set Com = CreateObject("ADODB.Command")
Set Com.ActiveConnection = con
Com.CommandText = "<" & entpr.ADsPath & ">;(objectCategory=CN=Domain-DNS,CN=Schema,CN=Configuration," & Replace(Replace(entpr.ADsPath, ".", ",DC="), "GC://", "DC=") & ");distinguishedname;subTree"
'strQuery = "<" & strADsPath & ">;(objectCategory=CN=Domain-DNS,CN=Schema,CN=Configuration,DC=<root domain name>);distinguishedName;subtree"

'WScript.Echo Com.CommandText
Set rs1 = Com.Execute

While Not rs1.EOF
    Domains = Domains + 1
    DNSDomainName rs1.Fields(0).Value, DottedName

    set adsNamespaceLDAP = GetObject("LDAP:")
    OpenDSObjectStr = "LDAP://" & DottedName & "/OU=Domain Controllers," & rs1.Fields(0).Value 
    'WScript.Echo OpenDSObjectStr
    Set adsContainer = adsNamespaceLDAP.OpenDSObject(OpenDSObjectStr, strAdminDN, strPassword, 0)
    adsContainer.GetInfo
    WScript.Echo "DottedName: " & DottedName 
    For Each adsMember In adsContainer
		adsMember.getinfo
		If adsMember.objectcategory = "CN=Computer,CN=Schema,CN=Configuration," & Replace(Replace(entpr.ADsPath, ".", ",DC="), "GC://", "DC=") Then
			WScript.Echo Mid(adsMember.name, 4)
			TotalDomainDCs = TotalDomainDCs + 1            
		End If
    Next
    
    
    wscript.Echo "Total DC's: " & TotalDomainDCs 
    TotalDomainDCs = 0
    rs1.MoveNext
Wend


Set oCont = GetObject("GC:")
For Each oGC In oCont
  strADsPath = oGC.ADsPath
  WScript.Echo VbCrLf & "Global Catalog is on domain: " & strADsPath
Next

sub DNSDomainName (TxtIn, TxtOut)
    TxtIn = TxtIn & ","
    TxtOut = mid(TxtIn,4,InStr(TxtIn,",")-4)
    TxtIn = right(TxtIn,(len(TxtIn)-InStr(TxtIn,",")))
    While len(TxtIn) > 0
        TxtOut = TxtOut & "." & mid(TxtIn,4,InStr(TxtIn,",")-4)
        TxtIn = right(TxtIn,(len(TxtIn)-InStr(TxtIn,",")))
    Wend
End Sub

Open in new window

Author

Commented:
Hi Rob i get a lot of details after which i get this at the end
Global Catalog is on domain: GC://Group.co.uk
Most Valuable Expert 2012
Top Expert 2014

Commented:
OK, again, I can't test this at all, but try this small script to check for one user account.

Change strUser to an account on your local domain, then change it to an account on another domain, and see if it finds it.

Regards,

Rob.
strUser = "rsampson"
strADsPath = Get_LDAP_User_Properties("user", "samAccountName", strUser, "adsPath")
If Left(strADsPath, 7) = "LDAP://" Then
	MsgBox "User " & strUser & " was found on the local domain at" & VbCrLf & strADsPath
Else
	strADsPath = Get_GC_Object_Properties("user", "samAccountName", "rsampson", "adsPath")
	If Left(strADsPath, 5) = "GC://" Then
		MsgBox "User " & strUser & " was found on the global catalog at" & VbCrLf & strADsPath
	Else
		MsgBox "User " & strUser & " was not found in the forest."
	End If
End If
	
Function Get_LDAP_User_Properties(strObjectType, strSearchField, strObjectToGet, strCommaDelimProps)
      
      ' This is a custom function that connects to the Active Directory, and returns the specific
      ' Active Directory attribute value, of a specific Object.
      ' strObjectType: usually "User" or "Computer"
      ' strSearchField: the field by which to seach the AD by. This acts like an SQL Query's WHERE clause.
      '				It filters the results by the value of strObjectToGet
      ' strObjectToGet: the value by which the results are filtered by, according the strSearchField.
      '				For example, if you are searching based on the user account name, strSearchField
      '				would be "samAccountName", and strObjectToGet would be that speicific account name,
      '				such as "jsmith".  This equates to "WHERE 'samAccountName' = 'jsmith'"
      '	strCommaDelimProps: the field from the object to actually return.  For example, if you wanted
      '				the home folder path, as defined by the AD, for a specific user, this would be
      '				"homeDirectory".  If you want to return the ADsPath so that you can bind to that
      '				user and get your own parameters from them, then use "ADsPath" as a return string,
      '				then bind to the user: Set objUser = GetObject("LDAP://" & strReturnADsPath)
      
      ' Now we're checking if the user account passed may have a domain already specified,
      ' in which case we connect to that domain in AD, instead of the default one.
      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
      ' Otherwise we just connect to the default domain
            Set objRootDSE = GetObject("LDAP://RootDSE")
            strDNSDomain = objRootDSE.Get("defaultNamingContext")
      End If

      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
      ' Define the maximum records to return
      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.
      strReturnVal = ""
      Do Until adoRecordset.EOF
          ' Retrieve values and display.    
          For intCount = LBound(arrProperties) To UBound(arrProperties)
                If strReturnVal = "" Then
                      strReturnVal = adoRecordset.Fields(intCount).Value
                Else
                      strReturnVal = strReturnVal & VbCrLf & adoRecordset.Fields(intCount).Value
                End If
          Next
          ' Move to the next record in the recordset.
          adoRecordset.MoveNext
      Loop

      ' Clean up.
      adoRecordset.Close
      adoConnection.Close
      Get_LDAP_User_Properties = strReturnVal

End Function

Function Get_GC_Object_Properties(strObjectType, strSearchField, strObjectToGet, strCommaDelimProps)
      
      ' This is a custom function that connects to the Active Directory, and returns the specific
      ' Active Directory attribute value, of a specific Object.
      ' strObjectType: usually "User" or "Computer"
      ' strSearchField: the field by which to seach the AD by. This acts like an SQL Query's WHERE clause.
      '				It filters the results by the value of strObjectToGet
      ' strObjectToGet: the value by which the results are filtered by, according the strSearchField.
      '				For example, if you are searching based on the user account name, strSearchField
      '				would be "samAccountName", and strObjectToGet would be that speicific account name,
      '				such as "jsmith".  This equates to "WHERE 'samAccountName' = 'jsmith'"
      '	strCommaDelimProps: the field from the object to actually return.  For example, if you wanted
      '				the home folder path, as defined by the AD, for a specific user, this would be
      '				"homeDirectory".  If you want to return the ADsPath so that you can bind to that
      '				user and get your own parameters from them, then use "ADsPath" as a return string,
      '				then bind to the user: Set objUser = GetObject("LDAP://" & strReturnADsPath)
      
	Set objGC = GetObject("GC:")
	For Each objChild In objGC
	    strBase = objChild.ADsPath
	Next
	' 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
	' Define the maximum records to return
	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.
	strReturnVal = ""
	Do Until adoRecordset.EOF
		' Retrieve values and display.    
		For intCount = LBound(arrProperties) To UBound(arrProperties)
			If strReturnVal = "" Then
				strReturnVal = adoRecordset.Fields(intCount).Value
			Else
				strReturnVal = strReturnVal & VbCrLf & adoRecordset.Fields(intCount).Value
			End If
		Next
		' Move to the next record in the recordset.
		adoRecordset.MoveNext
	Loop

	' Clean up.
	adoRecordset.Close
	adoConnection.Close
	Get_GC_Object_Properties = strReturnVal

End Function

Open in new window

Author

Commented:
Rob i get this

---------------------------

---------------------------
User Paulaa was not found in the forest.
---------------------------
OK  
---------------------------
Most Valuable Expert 2012
Top Expert 2014

Commented:
Is Group.co.uk the topmost domain in your forest?  If you use Active Directory Users and Computers to connect to that domain, then search for Paulaa, does it find it?

Rob.

Author

Commented:
Yes
Yes it does find
Most Valuable Expert 2012
Top Expert 2014

Commented:
What if you replace the top part of the script with this

strUser = "paulaa@domain.com"
strADsPath = Get_LDAP_User_Properties("user", "userPrincipalName", strUser, "adsPath")
If Left(strADsPath, 7) = "LDAP://" Then
      MsgBox "User " & strUser & " was found on the local domain at" & VbCrLf & strADsPath
Else
      strADsPath = Get_GC_Object_Properties("user", "userPrincipalName", "rsampson", "adsPath")
      If Left(strADsPath, 5) = "GC://" Then
            MsgBox "User " & strUser & " was found on the global catalog at" & VbCrLf & strADsPath
      Else
            MsgBox "User " & strUser & " was not found in the forest."
      End If
End If



and change strUser to the full userPrincipalName of the user (this can be found on the Account tab of a user with the Account logon name, and the value from the drop down box next to it).

Rob.

Author

Commented:
I check with my name itself but it fails for the local domain also.

Like
Sharath@groupplc.com

Most Valuable Expert 2012
Top Expert 2014

Commented:
Hmmm, if you run this, it will show you the UPN for your account.  Then change strUser to that, and see if it gets found.

Regards,

Rob.
Set objADSysInfo = CreateObject("ADSystemInfo")
Set objUser = GetObject("LDAP://" & objADSysInfo.UserName)
MsgBox objUser.userPrincipalName

Open in new window

Author

Commented:
Hi rob when i ran on my system i get the data and when added the same name it displayed to the code i get unknown

Author

Commented:
Hi Rob any views please...
Most Valuable Expert 2012
Top Expert 2014

Commented:
I can't find any samples of cross-domain scripting....the only one I've found so far that even comes close is this:
http://www.rlmueller.net/Programs/IsMember7.txt

which uses the Global Catalogue like I have been trying.  Tomorrow I will take bits from that script and try to get you to find an object....

Rob.
Most Valuable Expert 2012
Top Expert 2014

Commented:
Hmm, this site:
http://codeidol.com/active-directory/active-directory/Searching-and-Manipulating-Objects/Using-LDAP-Controls/

suggests there might be some sort of control you can set as a flag to prevent referrals.....but I'm not sure about it....I'll check that out too.

Rob.

Author

Commented:
Ok Rob thanks
Most Valuable Expert 2012
Top Expert 2014

Commented:
OK, the site about the Controls states they're not available to VBScript, so I think I'm going to abandon VBScript in this case, and see what the command ADFind can do, which I'm sure you've used before from previous questions, and guidance from AmazingTech or someone who likes DOS.

So, looking at a quick example, try this:
adfind -gcb -f name=”userloginid” distinguishedName

where userloginid is first, a user account local to your domain, and then one from another domain.  According to here:
http://blog.joeware.net/2009/10/21/1762/
this should be capable of searching the entire forest....

Regards,

Rob.

Author

Commented:
Rob i just tried but i get no records
Even when i put my name it gets "0" found
Most Valuable Expert 2012
Top Expert 2014

Commented:
Try changing
distinguishedName
to
dn
so it becomes
adfind -gcb -f name=”userloginid” dn

Author

Commented:
Still get "0" found
Most Valuable Expert 2012
Top Expert 2014

Commented:
Oh, silly me!  The filter is incorrect....try this

adfind -gcb -f "&(objectclass=user)(samaccountname=username)" dn

and change username to what you want to find.

I had trouble sometimes with the copy and paste because of the quotes, so if you get "filter error", manually type the quotes in, and see if that helps.

Regards,

Rob.

Author

Commented:
Hi Rob

Now it does work perfect

In some cases the same name finds 2 or more . As the same user will haev accounts in all domains.
When you are implementing in the excel can you change the color of the manager cell which was found and updated to Red so i know those are users who are not in local domain and a Different domain id was added.

Rob i am in very need of help on this post.Can you please have a look...

http://www.experts-exchange.com/Programming/Languages/Q_25153021.html
Most Valuable Expert 2012
Top Expert 2014

Commented:
OK, let's try this code.  It will look for the manager name (from column BI) across the domain, and return the distinguishedName attribute, which can hopefully be used to set that person as the manager for the username in column L.  It is full name in column BI right?  That seems to be what the code currently looks at.

It will hopefully be able to search cross-domain, across the entire forest, for the user.  It will tell you what accounts it finds.

You need to set:
    strADFind = "N:\Scripting\ADFind.exe"

to point to the ADFind tool.

Probably take a copy of your Excel file, and use this code on a smaller amount of rows.....

Regards,

Rob.
Sub Update_Seat()

'Active Directory
      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)
            strSerialNo = Trim(Cells(intRow, "T").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)
            strEmail = Trim(Cells(intRow, "O").Value)
            strEmpId = Trim(Cells(intRow, "E").Value)
            If strManager <> "" Then
                'strManagerDN = Get_LDAP_User_Properties("user", "name", strManager, "distinguishedName")
                strManagerDN = Find_DNs_With_ADFind("user", "name", strManager, "dn")
            Else
                strManagerDN = ""
            End If
            MsgBox "Manager found with username of " & strManager & ": " & vbCrLf & strManagerDN
            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 strBuilding = "C" Then
                    strArea = " (04-7100"
                    strNewNumber = "Ext:" & strExt & strArea & ") (" & strSeatNo & ")"
                ElseIf strBuilding = "P" Then
                    strArea = " (04-300"
                    strNewNumber = "Ext:" & strExt & strArea & ") (" & strSeatNo & ")"
                Else
                    strArea = " (04-3"
                    strNewNumber = "Ext:" & strExt & strArea & strExt & ") (" & strSeatNo & ")"
                End If
                
                If UCase(objuser.telephoneNumber) <> UCase(strNewNumber) Then
                    With Cells(intRow, "D").Interior
                        .ColorIndex = 36
                        .Pattern = xlSolid
                        .PatternColorIndex = xlAutomatic
                    End With
                    boolChanged = True
                    If strExt <> "" Then
                        objuser.telephoneNumber = UCase(strNewNumber)
                    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 = "EMP ID : " & strEmpId & vbCrLf & "EMAIL ADDRESS : " & strEmail & vbCrLf & "Machine Name : " & strMachine & vbCrLf & "Location : " & strSeatNo & vbCrLf & "Serial Number : " & strSerialNo
                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
                    With Cells(intRow, "T").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

Private Function Find_DNs_With_ADFind(strObjectType, strSearchField, strObjectToGet, strCommaDelimProps)
    strADFind = "N:\Scripting\ADFind.exe"
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objShell = CreateObject("WScript.Shell")
    If objFSO.FileExists(strADFind) = False Then
        MsgBox "Could not find ADFind"
    Else
        strADFind = objFSO.GetFile(strADFind).ShortPath
        strTempOutput = objFSO.GetParentFolderName(strADFind) & "\TempOutput.txt"
        ' First we are going to check the local domain for the object
        strCommand = "cmd /c " & strADFind & " -f ""&(objectclass=" & strObjectType & ")(" & strSearchField & "=" & strObjectToGet & ")"" " & strCommaDelimProps & " > " & strTempOutput
        objShell.Run strCommand, 0, True
        Set objFile = objFSO.OpenTextFile(strTempOutput, 1, False)
        strResult = ""
        While Not objFile.AtEndOfStream
            strLine = objFile.ReadLine
            If Left(LCase(strLine), 6) = "dn:cn=" Then
                If strResult = "" Then
                    strResult = Mid(strLine, 4)
                Else
                    strResult = strResult & ";" & Mid(strLine, 4)
                End If
            End If
        Wend
        objFile.Close
        objFSO.DeleteFile strTempOutput, True
        ' Now if there were no objects found, search the entire forest, which should work cross-domain
        If strResult = "" Then
            strCommand = "cmd /c " & strADFind & " -gcb -f ""&(objectclass=" & strObjectType & ")(" & strSearchField & "=" & strObjectToGet & ")"" " & strCommaDelimProps & " > " & strTempOutput
            objShell.Run strCommand, 0, True
            Set objFile = objFSO.OpenTextFile(strTempOutput, 1, False)
            strResult = ""
            While Not objFile.AtEndOfStream
                strLine = objFile.ReadLine
                If Left(LCase(strLine), 6) = "dn:cn=" Then
                    If strResult = "" Then
                        strResult = Mid(strLine, 4)
                    Else
                        strResult = strResult & ";" & Mid(strLine, 4)
                    End If
                End If
            Wend
            objFile.Close
            objFSO.DeleteFile strTempOutput, True
        End If
    End If
    Find_DNs_With_ADFind = strResult
End Function

Open in new window

Author

Commented:
When i put a local domain user i get the DN details and it says found., When i add a user name which is in different domain it does say its found but do not get the DN and does not add the "BI" user as manager
Most Valuable Expert 2012
Top Expert 2014

Commented:
Are you leaving column E as a local user and making column BI a non-local user?  I didn't make any change for the column E value....that is still local....can you test with column E local and column BI non local?

Author

Commented:
Colum E will always be only local users
Only BI will differ
Most Valuable Expert 2012
Top Expert 2014

Commented:
Does column BI have full name or login id?

It's currently looking for full name.  If you are using login ids in column BI, then change
strManagerDN = Find_DNs_With_ADFind("user", "name", strManager, "dn")

to this
strManagerDN = Find_DNs_With_ADFind("user", "samAccountName", strManager, "dn")

Rob.

Author

Commented:
I had the NTlogin..Thanks Rob works perfect
Can i have 3 colors
1. Yellow if change is happened.
2. Green if The data matches the data in AD
3. Red if Ntlogin in Excel not found in AD

These colors for all the data in sheet
Most Valuable Expert 2012
Top Expert 2014

Commented:
It's the end of the day for me, so I won't be able to do that today.  I am unavailable all of next week, so I will add the colour coding in early March.

I'm glad that's worked cross-domain.  That's the first code I've provided for you that works cross-domain!  Thanks to ADFind.....VBScript just won't do the job!

Regards,

Rob.

Author

Commented:
Ok Rob thank U

Author

Commented:
Hi Rob when i run on my actual file i get the attached error . when debug goes here
                    objuser.SetInfo
Capture.JPG
Most Valuable Expert 2012
Top Expert 2014

Commented:
I figured that might happen.  I think we'll have to use ADMod as well to make the change, as that will hopefully work cross-domain like ADFind does....I'll look into the syntax for that tomorrow.

Rob.
Most Valuable Expert 2012
Top Expert 2014

Commented:
OK, please try this code.  I have not included any check on whether the adding of the manager was successful, so you will need to check that manually.  Clear the manager of a user, then run the code against them to add a manager, and see if it was successful.

You ned to modify the paths to ADFind.exe and ADMod.exe

Regards,

Rob.
Sub Update_Seat()
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objShell = CreateObject("WScript.Shell")
    strADMod = "N:\Scripting\ADMod.exe"
    If objFSO.FileExists(strADMod) = False Then
        MsgBox "Could not find ADMod. No modifications will be made."
    Else
       'Active Directory
       strADMod = objFSO.GetFile(strADMod).ShortPath
       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)
               strSerialNo = Trim(Cells(intRow, "T").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)
               strEmail = Trim(Cells(intRow, "O").Value)
               strEmpId = Trim(Cells(intRow, "E").Value)
               If strManager <> "" Then
                   'strManagerDN = Get_LDAP_User_Properties("user", "name", strManager, "distinguishedName")
                   strManagerDN = Find_DNs_With_ADFind("user", "samAccountName", strManager, "dn")
               Else
                   strManagerDN = ""
               End If
               'MsgBox "Manager found with username of " & strManager & ": " & vbCrLf & strManagerDN
               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 strBuilding = "C" Then
                       strArea = " (04-7100"
                       strNewNumber = "Ext:" & strExt & strArea & ") (" & strSeatNo & ")"
                   ElseIf strBuilding = "P" Then
                       strArea = " (04-300"
                       strNewNumber = "Ext:" & strExt & strArea & ") (" & strSeatNo & ")"
                   Else
                       strArea = " (04-3"
                       strNewNumber = "Ext:" & strExt & strArea & strExt & ") (" & strSeatNo & ")"
                   End If
                   
                   If UCase(objUser.telephoneNumber) <> UCase(strNewNumber) Then
                       With Cells(intRow, "D").Interior
                           .ColorIndex = 36
                           .Pattern = xlSolid
                           .PatternColorIndex = xlAutomatic
                       End With
                       boolChanged = True
                       If strExt <> "" Then
                           objUser.telephoneNumber = UCase(strNewNumber)
                       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 = "EMP ID : " & strEmpId & vbCrLf & "EMAIL ADDRESS : " & strEmail & vbCrLf & "Machine Name : " & strMachine & vbCrLf & "Location : " & strSeatNo & vbCrLf & "Serial Number : " & strSerialNo
                   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
                       With Cells(intRow, "T").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
                               strCommand = "cmd /c " & strADMod & " -b """ & objUser.DistinguishedName & """ ""manager::" & strManagerDN & """"
                               objShell.Run strCommand, 0, True
                           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 If
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

Private Function Find_DNs_With_ADFind(strObjectType, strSearchField, strObjectToGet, strCommaDelimProps)
    strADFind = "N:\Scripting\ADFind.exe"
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objShell = CreateObject("WScript.Shell")
    If objFSO.FileExists(strADFind) = False Then
        MsgBox "Could not find ADFind"
    Else
        strADFind = objFSO.GetFile(strADFind).ShortPath
        strTempOutput = objFSO.GetParentFolderName(strADFind) & "\TempOutput.txt"
        ' First we are going to check the local domain for the object
        strCommand = "cmd /c " & strADFind & " -f ""&(objectclass=" & strObjectType & ")(" & strSearchField & "=" & strObjectToGet & ")"" " & strCommaDelimProps & " > " & strTempOutput
        objShell.Run strCommand, 0, True
        Set objFile = objFSO.OpenTextFile(strTempOutput, 1, False)
        strResult = ""
        While Not objFile.AtEndOfStream
            strLine = objFile.ReadLine
            If Left(LCase(strLine), 6) = "dn:cn=" Then
                If strResult = "" Then
                    strResult = Mid(strLine, 4)
                Else
                    strResult = strResult & ";" & Mid(strLine, 4)
                End If
            End If
        Wend
        objFile.Close
        objFSO.DeleteFile strTempOutput, True
        ' Now if there were no objects found, search the entire forest, which should work cross-domain
        If strResult = "" Then
            strCommand = "cmd /c " & strADFind & " -gcb -f ""&(objectclass=" & strObjectType & ")(" & strSearchField & "=" & strObjectToGet & ")"" " & strCommaDelimProps & " > " & strTempOutput
            objShell.Run strCommand, 0, True
            Set objFile = objFSO.OpenTextFile(strTempOutput, 1, False)
            strResult = ""
            While Not objFile.AtEndOfStream
                strLine = objFile.ReadLine
                If Left(LCase(strLine), 6) = "dn:cn=" Then
                    If strResult = "" Then
                        strResult = Mid(strLine, 4)
                    Else
                        strResult = strResult & ";" & Mid(strLine, 4)
                    End If
                End If
            Wend
            objFile.Close
            objFSO.DeleteFile strTempOutput, True
        End If
    End If
    Find_DNs_With_ADFind = strResult
End Function

Open in new window

Author

Commented:
Thanks Rob works fine . Just tested for 1. Can you do the color changes also so i can run on all data and see if it errors on any point
Most Valuable Expert 2012
Top Expert 2014

Commented:
OK, try this.....

Regards,

Rob.
Sub Update_Seat()
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objShell = CreateObject("WScript.Shell")
    strADMod = "N:\Scripting\ADMod.exe"
    If objFSO.FileExists(strADMod) = False Then
        MsgBox "Could not find ADMod. No modifications will be made."
    Else
       'Active Directory
       strADMod = objFSO.GetFile(strADMod).ShortPath
       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)
               strSerialNo = Trim(Cells(intRow, "T").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)
               strEmail = Trim(Cells(intRow, "O").Value)
               strEmpId = Trim(Cells(intRow, "E").Value)
               If strManager <> "" Then
                   'strManagerDN = Get_LDAP_User_Properties("user", "name", strManager, "distinguishedName")
                   strManagerDN = Find_DNs_With_ADFind("user", "samAccountName", strManager, "dn")
               Else
                   strManagerDN = ""
               End If
               'MsgBox "Manager found with username of " & strManager & ": " & vbCrLf & strManagerDN
               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
                   
                   '.ColorIndex = 36 for Yellow, 35 for light green, and 3 for Red
                   
                   If UCase(objUser.physicalDeliveryOfficeName) <> UCase(strBuilding) Then
                       With Cells(intRow, "C").Interior
                           .ColorIndex = 36 ' Yellow
                           .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
                   Else
                       With Cells(intRow, "C").Interior
                           .ColorIndex = 35 ' Light Green
                           .Pattern = xlSolid
                           .PatternColorIndex = xlAutomatic
                       End With
                   End If
                   
                   If strBuilding = "C" Then
                       strArea = " (04-7100"
                       strNewNumber = "Ext:" & strExt & strArea & ") (" & strSeatNo & ")"
                   ElseIf strBuilding = "P" Then
                       strArea = " (04-300"
                       strNewNumber = "Ext:" & strExt & strArea & ") (" & strSeatNo & ")"
                   Else
                       strArea = " (04-3"
                       strNewNumber = "Ext:" & strExt & strArea & strExt & ") (" & strSeatNo & ")"
                   End If
                   
                   If UCase(objUser.telephoneNumber) <> UCase(strNewNumber) Then
                       With Cells(intRow, "D").Interior
                           .ColorIndex = 36
                           .Pattern = xlSolid
                           .PatternColorIndex = xlAutomatic
                       End With
                       boolChanged = True
                       If strExt <> "" Then
                           objUser.telephoneNumber = UCase(strNewNumber)
                       Else
                           objUser.PutEx ADS_PROPERTY_CLEAR, "telephoneNumber", 0
                       End If
                   Else
                       With Cells(intRow, "D").Interior
                           .ColorIndex = 35 ' Light Green
                           .Pattern = xlSolid
                           .PatternColorIndex = xlAutomatic
                       End With
                   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
                   Else
                       With Cells(intRow, "H").Interior
                           .ColorIndex = 35 ' Light Green
                           .Pattern = xlSolid
                           .PatternColorIndex = xlAutomatic
                       End With
                   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
                   Else
                       With Cells(intRow, "J").Interior
                           .ColorIndex = 35 ' Light Green
                           .Pattern = xlSolid
                           .PatternColorIndex = xlAutomatic
                       End With
                   End If
                   
                   strNotesText = "EMP ID : " & strEmpId & vbCrLf & "EMAIL ADDRESS : " & strEmail & vbCrLf & "Machine Name : " & strMachine & vbCrLf & "Location : " & strSeatNo & vbCrLf & "Serial Number : " & strSerialNo
                   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
                       With Cells(intRow, "T").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
                   Else
                       With Cells(intRow, "B").Interior
                           .ColorIndex = 35 ' Light Green
                           .Pattern = xlSolid
                           .PatternColorIndex = xlAutomatic
                       End With
                       With Cells(intRow, "Q").Interior
                           .ColorIndex = 35 ' Light Green
                           .Pattern = xlSolid
                           .PatternColorIndex = xlAutomatic
                       End With
                       With Cells(intRow, "T").Interior
                           .ColorIndex = 35 ' Light Green
                           .Pattern = xlSolid
                           .PatternColorIndex = xlAutomatic
                       End With
                   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
                               strCommand = "cmd /c " & strADMod & " -b """ & objUser.DistinguishedName & """ ""manager::" & strManagerDN & """"
                               objShell.Run strCommand, 0, True
                           Else
                               With Cells(intRow, "BI").Interior
                                   .ColorIndex = 35
                                   .Pattern = xlSolid
                                   .PatternColorIndex = xlAutomatic
                               End With
                           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
               Else
                   With Cells(intRow, "L").Interior
                   .ColorIndex = 3
                   .Pattern = xlSolid
                   .PatternColorIndex = xlAutomatic
                   End With
               End If
           End If
       Next
       Application.EnableEvents = True
    End If
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

Private Function Find_DNs_With_ADFind(strObjectType, strSearchField, strObjectToGet, strCommaDelimProps)
    strADFind = "N:\Scripting\ADFind.exe"
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objShell = CreateObject("WScript.Shell")
    If objFSO.FileExists(strADFind) = False Then
        MsgBox "Could not find ADFind"
    Else
        strADFind = objFSO.GetFile(strADFind).ShortPath
        strTempOutput = objFSO.GetParentFolderName(strADFind) & "\TempOutput.txt"
        ' First we are going to check the local domain for the object
        strCommand = "cmd /c " & strADFind & " -f ""&(objectclass=" & strObjectType & ")(" & strSearchField & "=" & strObjectToGet & ")"" " & strCommaDelimProps & " > " & strTempOutput
        objShell.Run strCommand, 0, True
        Set objFile = objFSO.OpenTextFile(strTempOutput, 1, False)
        strResult = ""
        While Not objFile.AtEndOfStream
            strLine = objFile.ReadLine
            If Left(LCase(strLine), 6) = "dn:cn=" Then
                If strResult = "" Then
                    strResult = Mid(strLine, 4)
                Else
                    strResult = strResult & ";" & Mid(strLine, 4)
                End If
            End If
        Wend
        objFile.Close
        objFSO.DeleteFile strTempOutput, True
        ' Now if there were no objects found, search the entire forest, which should work cross-domain
        If strResult = "" Then
            strCommand = "cmd /c " & strADFind & " -gcb -f ""&(objectclass=" & strObjectType & ")(" & strSearchField & "=" & strObjectToGet & ")"" " & strCommaDelimProps & " > " & strTempOutput
            objShell.Run strCommand, 0, True
            Set objFile = objFSO.OpenTextFile(strTempOutput, 1, False)
            strResult = ""
            While Not objFile.AtEndOfStream
                strLine = objFile.ReadLine
                If Left(LCase(strLine), 6) = "dn:cn=" Then
                    If strResult = "" Then
                        strResult = Mid(strLine, 4)
                    Else
                        strResult = strResult & ";" & Mid(strLine, 4)
                    End If
                End If
            Wend
            objFile.Close
            objFSO.DeleteFile strTempOutput, True
        End If
    End If
    Find_DNs_With_ADFind = strResult
End Function

Open in new window

Most Valuable Expert 2012
Top Expert 2014

Commented:
Did you try the change above for the colour codes?

Rob.

Author

Commented:
Sorry missed the alert
What should i have in BI full name or Ntlogin
I tried with both and i get yellow color for 1 but no change in AD
For another no color at all.
If failed can i get a color
Most Valuable Expert 2012
Top Expert 2014

Commented:
Hmmmm, can you try this.  You should actually have the Full Name for column BI, sorry, I think I changed that in the last code...

Rob.
Sub Update_Seat()
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objShell = CreateObject("WScript.Shell")
    strADMod = "N:\Scripting\ADMod.exe"
    If objFSO.FileExists(strADMod) = False Then
        MsgBox "Could not find ADMod. No modifications will be made."
    Else
       'Active Directory
       strADMod = objFSO.GetFile(strADMod).ShortPath
       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)
               strSerialNo = Trim(Cells(intRow, "T").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)
               strEmail = Trim(Cells(intRow, "O").Value)
               strEmpId = Trim(Cells(intRow, "E").Value)
               If strManager <> "" Then
                   'strManagerDN = Get_LDAP_User_Properties("user", "name", strManager, "distinguishedName")
                   'strManagerDN = Find_DNs_With_ADFind("user", "samAccountName", strManager, "dn")
                   strManagerDN = Find_DNs_With_ADFind("user", "name", strManager, "dn")
               Else
                   strManagerDN = ""
               End If
               'MsgBox "Manager found with username of " & strManager & ": " & vbCrLf & strManagerDN
               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
                   
                   '.ColorIndex = 36 for Yellow, 35 for light green, and 3 for Red
                   
                   If UCase(objUser.physicalDeliveryOfficeName) <> UCase(strBuilding) Then
                       With Cells(intRow, "C").Interior
                           .ColorIndex = 36 ' Yellow
                           .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
                   Else
                       With Cells(intRow, "C").Interior
                           .ColorIndex = 35 ' Light Green
                           .Pattern = xlSolid
                           .PatternColorIndex = xlAutomatic
                       End With
                   End If
                   
                   If strBuilding = "C" Then
                       strArea = " (04-7100"
                       strNewNumber = "Ext:" & strExt & strArea & ") (" & strSeatNo & ")"
                   ElseIf strBuilding = "P" Then
                       strArea = " (04-300"
                       strNewNumber = "Ext:" & strExt & strArea & ") (" & strSeatNo & ")"
                   Else
                       strArea = " (04-3"
                       strNewNumber = "Ext:" & strExt & strArea & strExt & ") (" & strSeatNo & ")"
                   End If
                   
                   If UCase(objUser.telephoneNumber) <> UCase(strNewNumber) Then
                       With Cells(intRow, "D").Interior
                           .ColorIndex = 36
                           .Pattern = xlSolid
                           .PatternColorIndex = xlAutomatic
                       End With
                       boolChanged = True
                       If strExt <> "" Then
                           objUser.telephoneNumber = UCase(strNewNumber)
                       Else
                           objUser.PutEx ADS_PROPERTY_CLEAR, "telephoneNumber", 0
                       End If
                   Else
                       With Cells(intRow, "D").Interior
                           .ColorIndex = 35 ' Light Green
                           .Pattern = xlSolid
                           .PatternColorIndex = xlAutomatic
                       End With
                   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
                   Else
                       With Cells(intRow, "H").Interior
                           .ColorIndex = 35 ' Light Green
                           .Pattern = xlSolid
                           .PatternColorIndex = xlAutomatic
                       End With
                   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
                   Else
                       With Cells(intRow, "J").Interior
                           .ColorIndex = 35 ' Light Green
                           .Pattern = xlSolid
                           .PatternColorIndex = xlAutomatic
                       End With
                   End If
                   
                   strNotesText = "EMP ID : " & strEmpId & vbCrLf & "EMAIL ADDRESS : " & strEmail & vbCrLf & "Machine Name : " & strMachine & vbCrLf & "Location : " & strSeatNo & vbCrLf & "Serial Number : " & strSerialNo
                   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
                       With Cells(intRow, "T").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
                   Else
                       With Cells(intRow, "B").Interior
                           .ColorIndex = 35 ' Light Green
                           .Pattern = xlSolid
                           .PatternColorIndex = xlAutomatic
                       End With
                       With Cells(intRow, "Q").Interior
                           .ColorIndex = 35 ' Light Green
                           .Pattern = xlSolid
                           .PatternColorIndex = xlAutomatic
                       End With
                       With Cells(intRow, "T").Interior
                           .ColorIndex = 35 ' Light Green
                           .Pattern = xlSolid
                           .PatternColorIndex = xlAutomatic
                       End With
                   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
                                strCommand = "cmd /c " & strADMod & " -b """ & objUser.DistinguishedName & """ ""manager::" & strManagerDN & """"
                                objShell.Run strCommand, 0, True
                            Else
                                With Cells(intRow, "BI").Interior
                                   .ColorIndex = 35
                                   .Pattern = xlSolid
                                   .PatternColorIndex = xlAutomatic
                                End With
                            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
                    ElseIf strManager <> "" Then
                        ' Manager was not found
                        With Cells(intRow, "BI").Interior
                           .ColorIndex = 3
                           .Pattern = xlSolid
                           .PatternColorIndex = xlAutomatic
                        End With
                    Else
                        ' No change
                        With Cells(intRow, "BI").Interior
                           .ColorIndex = 35
                           .Pattern = xlSolid
                           .PatternColorIndex = xlAutomatic
                        End With
                    End If
                   
                   If boolChanged = True Then
                       objUser.SetInfo
                   End If
                   Set objUser = Nothing
               Else
                   With Cells(intRow, "L").Interior
                   .ColorIndex = 3
                   .Pattern = xlSolid
                   .PatternColorIndex = xlAutomatic
                   End With
               End If
           End If
       Next
       Application.EnableEvents = True
    End If
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

Private Function Find_DNs_With_ADFind(strObjectType, strSearchField, strObjectToGet, strCommaDelimProps)
    strADFind = "N:\Scripting\ADFind.exe"
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objShell = CreateObject("WScript.Shell")
    If objFSO.FileExists(strADFind) = False Then
        MsgBox "Could not find ADFind"
    Else
        strADFind = objFSO.GetFile(strADFind).ShortPath
        strTempOutput = objFSO.GetParentFolderName(strADFind) & "\TempOutput.txt"
        ' First we are going to check the local domain for the object
        strCommand = "cmd /c " & strADFind & " -f ""&(objectclass=" & strObjectType & ")(" & strSearchField & "=" & strObjectToGet & ")"" " & strCommaDelimProps & " > " & strTempOutput
        objShell.Run strCommand, 0, True
        Set objFile = objFSO.OpenTextFile(strTempOutput, 1, False)
        strResult = ""
        While Not objFile.AtEndOfStream
            strLine = objFile.ReadLine
            If Left(LCase(strLine), 6) = "dn:cn=" Then
                If strResult = "" Then
                    strResult = Mid(strLine, 4)
                Else
                    strResult = strResult & ";" & Mid(strLine, 4)
                End If
            End If
        Wend
        objFile.Close
        objFSO.DeleteFile strTempOutput, True
        ' Now if there were no objects found, search the entire forest, which should work cross-domain
        If strResult = "" Then
            strCommand = "cmd /c " & strADFind & " -gcb -f ""&(objectclass=" & strObjectType & ")(" & strSearchField & "=" & strObjectToGet & ")"" " & strCommaDelimProps & " > " & strTempOutput
            objShell.Run strCommand, 0, True
            Set objFile = objFSO.OpenTextFile(strTempOutput, 1, False)
            strResult = ""
            While Not objFile.AtEndOfStream
                strLine = objFile.ReadLine
                If Left(LCase(strLine), 6) = "dn:cn=" Then
                    If strResult = "" Then
                        strResult = Mid(strLine, 4)
                    Else
                        strResult = strResult & ";" & Mid(strLine, 4)
                    End If
                End If
            Wend
            objFile.Close
            objFSO.DeleteFile strTempOutput, True
        End If
    End If
    Find_DNs_With_ADFind = strResult
End Function

Open in new window

Author

Commented:
Rob for 2 User i gave full name in "BI" and i get a yellow color for 1 which is in the local Domain for another manager which is on the root Domain i get no color.
For bother when i see in AD there is no change
Most Valuable Expert 2012
Top Expert 2014

Commented:
Did you clear the colours before running it, and change the paths to ADMod and ADFind?

For the one where the manager has no colour, what is the colour of column L?

Rob.

Author

Commented:
Yes i did change all colors to white before run
I changed the paths also
No colors in Colum L
Most Valuable Expert 2012
Top Expert 2014

Commented:
Please try this.

Regards,

Rob.
Sub Update_Seat()
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objShell = CreateObject("WScript.Shell")
    strADMod = "N:\Scripting\ADMod.exe"
    If objFSO.FileExists(strADMod) = False Then
        MsgBox "Could not find ADMod. No modifications will be made."
    Else
       'Active Directory
       strADMod = objFSO.GetFile(strADMod).ShortPath
       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)
               strSerialNo = Trim(Cells(intRow, "T").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)
               strEmail = Trim(Cells(intRow, "O").Value)
               strEmpId = Trim(Cells(intRow, "E").Value)
               If strManager <> "" Then
                   'strManagerDN = Get_LDAP_User_Properties("user", "name", strManager, "distinguishedName")
                   'strManagerDN = Find_DNs_With_ADFind("user", "samAccountName", strManager, "dn")
                   strManagerDN = Find_DNs_With_ADFind("user", "name", strManager, "dn")
               Else
                   strManagerDN = ""
               End If
               'MsgBox "Manager found with username of " & strManager & ": " & vbCrLf & strManagerDN
               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
                   
                   '.ColorIndex = 36 for Yellow, 35 for light green, and 3 for Red
                   
                   If UCase(objUser.physicalDeliveryOfficeName) <> UCase(strBuilding) Then
                       With Cells(intRow, "C").Interior
                           .ColorIndex = 36 ' Yellow
                           .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
                   Else
                       With Cells(intRow, "C").Interior
                           .ColorIndex = 35 ' Light Green
                           .Pattern = xlSolid
                           .PatternColorIndex = xlAutomatic
                       End With
                   End If
                   
                   If strBuilding = "C" Then
                       strArea = " (04-7100"
                       strNewNumber = "Ext:" & strExt & strArea & ") (" & strSeatNo & ")"
                   ElseIf strBuilding = "P" Then
                       strArea = " (04-300"
                       strNewNumber = "Ext:" & strExt & strArea & ") (" & strSeatNo & ")"
                   Else
                       strArea = " (04-3"
                       strNewNumber = "Ext:" & strExt & strArea & strExt & ") (" & strSeatNo & ")"
                   End If
                   
                   If UCase(objUser.telephoneNumber) <> UCase(strNewNumber) Then
                       With Cells(intRow, "D").Interior
                           .ColorIndex = 36
                           .Pattern = xlSolid
                           .PatternColorIndex = xlAutomatic
                       End With
                       boolChanged = True
                       If strExt <> "" Then
                           objUser.telephoneNumber = UCase(strNewNumber)
                       Else
                           objUser.PutEx ADS_PROPERTY_CLEAR, "telephoneNumber", 0
                       End If
                   Else
                       With Cells(intRow, "D").Interior
                           .ColorIndex = 35 ' Light Green
                           .Pattern = xlSolid
                           .PatternColorIndex = xlAutomatic
                       End With
                   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
                   Else
                       With Cells(intRow, "H").Interior
                           .ColorIndex = 35 ' Light Green
                           .Pattern = xlSolid
                           .PatternColorIndex = xlAutomatic
                       End With
                   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
                   Else
                       With Cells(intRow, "J").Interior
                           .ColorIndex = 35 ' Light Green
                           .Pattern = xlSolid
                           .PatternColorIndex = xlAutomatic
                       End With
                   End If
                   
                   strNotesText = "EMP ID : " & strEmpId & vbCrLf & "EMAIL ADDRESS : " & strEmail & vbCrLf & "Machine Name : " & strMachine & vbCrLf & "Location : " & strSeatNo & vbCrLf & "Serial Number : " & strSerialNo
                   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
                       With Cells(intRow, "T").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
                   Else
                       With Cells(intRow, "B").Interior
                           .ColorIndex = 35 ' Light Green
                           .Pattern = xlSolid
                           .PatternColorIndex = xlAutomatic
                       End With
                       With Cells(intRow, "Q").Interior
                           .ColorIndex = 35 ' Light Green
                           .Pattern = xlSolid
                           .PatternColorIndex = xlAutomatic
                       End With
                       With Cells(intRow, "T").Interior
                           .ColorIndex = 35 ' Light Green
                           .Pattern = xlSolid
                           .PatternColorIndex = xlAutomatic
                       End With
                   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
                                strCommand = "cmd /c " & strADMod & " -b """ & objUser.DistinguishedName & """ ""manager::" & strManagerDN & """"
                                objShell.Run strCommand, 0, True
                            Else
                                With Cells(intRow, "BI").Interior
                                   .ColorIndex = 35
                                   .Pattern = xlSolid
                                   .PatternColorIndex = xlAutomatic
                                End With
                            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 <> "" And strManager = "" 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
                    ElseIf strManager <> "" Then
                        ' Manager was not found, so we clear the manager
                        With Cells(intRow, "BI").Interior
                           .ColorIndex = 3
                           .Pattern = xlSolid
                           .PatternColorIndex = xlAutomatic
                        End With
                        boolChanged = True
                        objUser.PutEx ADS_PROPERTY_CLEAR, "Manager", 0
                    Else
                        ' No change
                        With Cells(intRow, "BI").Interior
                           .ColorIndex = 35
                           .Pattern = xlSolid
                           .PatternColorIndex = xlAutomatic
                        End With
                    End If
                   
                   If boolChanged = True Then
                       objUser.SetInfo
                   End If
                   Set objUser = Nothing
               Else
                   With Cells(intRow, "L").Interior
                   .ColorIndex = 3
                   .Pattern = xlSolid
                   .PatternColorIndex = xlAutomatic
                   End With
               End If
           End If
       Next
       Application.EnableEvents = True
    End If
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

Private Function Find_DNs_With_ADFind(strObjectType, strSearchField, strObjectToGet, strCommaDelimProps)
    strADFind = "N:\Scripting\ADFind.exe"
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objShell = CreateObject("WScript.Shell")
    If objFSO.FileExists(strADFind) = False Then
        MsgBox "Could not find ADFind"
    Else
        strADFind = objFSO.GetFile(strADFind).ShortPath
        strTempOutput = objFSO.GetParentFolderName(strADFind) & "\TempOutput.txt"
        ' First we are going to check the local domain for the object
        strCommand = "cmd /c " & strADFind & " -f ""&(objectclass=" & strObjectType & ")(" & strSearchField & "=" & strObjectToGet & ")"" " & strCommaDelimProps & " > " & strTempOutput
        objShell.Run strCommand, 0, True
        Set objFile = objFSO.OpenTextFile(strTempOutput, 1, False)
        strResult = ""
        While Not objFile.AtEndOfStream
            strLine = objFile.ReadLine
            If Left(LCase(strLine), 6) = "dn:cn=" Then
                If strResult = "" Then
                    strResult = Mid(strLine, 4)
                Else
                    strResult = strResult & ";" & Mid(strLine, 4)
                End If
            End If
        Wend
        objFile.Close
        objFSO.DeleteFile strTempOutput, True
        ' Now if there were no objects found, search the entire forest, which should work cross-domain
        If strResult = "" Then
            strCommand = "cmd /c " & strADFind & " -gcb -f ""&(objectclass=" & strObjectType & ")(" & strSearchField & "=" & strObjectToGet & ")"" " & strCommaDelimProps & " > " & strTempOutput
            objShell.Run strCommand, 0, True
            Set objFile = objFSO.OpenTextFile(strTempOutput, 1, False)
            strResult = ""
            While Not objFile.AtEndOfStream
                strLine = objFile.ReadLine
                If Left(LCase(strLine), 6) = "dn:cn=" Then
                    If strResult = "" Then
                        strResult = Mid(strLine, 4)
                    Else
                        strResult = strResult & ";" & Mid(strLine, 4)
                    End If
                End If
            Wend
            objFile.Close
            objFSO.DeleteFile strTempOutput, True
        End If
    End If
    Find_DNs_With_ADFind = strResult
End Function

Open in new window

Author

Commented:
Rob i get the attached error
The local manager is added fine. But not the root domain manager
Color for both are changed yellow
Capture.JPG
Most Valuable Expert 2012
Top Expert 2014
Commented:
Try this.

Rob.
Sub Update_Seat()
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objShell = CreateObject("WScript.Shell")
    strADMod = "N:\Scripting\ADMod.exe"
    If objFSO.FileExists(strADMod) = False Then
        MsgBox "Could not find ADMod. No modifications will be made."
    Else
       'Active Directory
       strADMod = objFSO.GetFile(strADMod).ShortPath
       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)
               strSerialNo = Trim(Cells(intRow, "T").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)
               strEmail = Trim(Cells(intRow, "O").Value)
               strEmpId = Trim(Cells(intRow, "E").Value)
               If strManager <> "" Then
                   'strManagerDN = Get_LDAP_User_Properties("user", "name", strManager, "distinguishedName")
                   'strManagerDN = Find_DNs_With_ADFind("user", "samAccountName", strManager, "dn")
                   strManagerDN = Find_DNs_With_ADFind("user", "name", strManager, "dn")
               Else
                   strManagerDN = ""
               End If
               'MsgBox "Manager found with username of " & strManager & ": " & vbCrLf & strManagerDN
               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
                   
                   '.ColorIndex = 36 for Yellow, 35 for light green, and 3 for Red
                   
                   If UCase(objUser.physicalDeliveryOfficeName) <> UCase(strBuilding) Then
                       With Cells(intRow, "C").Interior
                           .ColorIndex = 36 ' Yellow
                           .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
                   Else
                       With Cells(intRow, "C").Interior
                           .ColorIndex = 35 ' Light Green
                           .Pattern = xlSolid
                           .PatternColorIndex = xlAutomatic
                       End With
                   End If
                   
                   If strBuilding = "C" Then
                       strArea = " (04-7100"
                       strNewNumber = "Ext:" & strExt & strArea & ") (" & strSeatNo & ")"
                   ElseIf strBuilding = "P" Then
                       strArea = " (04-300"
                       strNewNumber = "Ext:" & strExt & strArea & ") (" & strSeatNo & ")"
                   Else
                       strArea = " (04-3"
                       strNewNumber = "Ext:" & strExt & strArea & strExt & ") (" & strSeatNo & ")"
                   End If
                   
                   If UCase(objUser.telephoneNumber) <> UCase(strNewNumber) Then
                       With Cells(intRow, "D").Interior
                           .ColorIndex = 36
                           .Pattern = xlSolid
                           .PatternColorIndex = xlAutomatic
                       End With
                       boolChanged = True
                       If strExt <> "" Then
                           objUser.telephoneNumber = UCase(strNewNumber)
                       Else
                           objUser.PutEx ADS_PROPERTY_CLEAR, "telephoneNumber", 0
                       End If
                   Else
                       With Cells(intRow, "D").Interior
                           .ColorIndex = 35 ' Light Green
                           .Pattern = xlSolid
                           .PatternColorIndex = xlAutomatic
                       End With
                   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
                   Else
                       With Cells(intRow, "H").Interior
                           .ColorIndex = 35 ' Light Green
                           .Pattern = xlSolid
                           .PatternColorIndex = xlAutomatic
                       End With
                   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
                   Else
                       With Cells(intRow, "J").Interior
                           .ColorIndex = 35 ' Light Green
                           .Pattern = xlSolid
                           .PatternColorIndex = xlAutomatic
                       End With
                   End If
                   
                   strNotesText = "EMP ID : " & strEmpId & vbCrLf & "EMAIL ADDRESS : " & strEmail & vbCrLf & "Machine Name : " & strMachine & vbCrLf & "Location : " & strSeatNo & vbCrLf & "Serial Number : " & strSerialNo
                   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
                       With Cells(intRow, "T").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
                   Else
                       With Cells(intRow, "B").Interior
                           .ColorIndex = 35 ' Light Green
                           .Pattern = xlSolid
                           .PatternColorIndex = xlAutomatic
                       End With
                       With Cells(intRow, "Q").Interior
                           .ColorIndex = 35 ' Light Green
                           .Pattern = xlSolid
                           .PatternColorIndex = xlAutomatic
                       End With
                       With Cells(intRow, "T").Interior
                           .ColorIndex = 35 ' Light Green
                           .Pattern = xlSolid
                           .PatternColorIndex = xlAutomatic
                       End With
                   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
                                strCommand = "cmd /c " & strADMod & " -b """ & objUser.DistinguishedName & """ ""manager::" & strManagerDN & """"
                                objShell.Run strCommand, 0, True
                            Else
                                With Cells(intRow, "BI").Interior
                                   .ColorIndex = 35
                                   .Pattern = xlSolid
                                   .PatternColorIndex = xlAutomatic
                                End With
                            End If
                        Else
                            With Cells(intRow, "BI").Interior
                               .ColorIndex = 36
                               .Pattern = xlSolid
                               .PatternColorIndex = xlAutomatic
                            End With
                            boolChanged = True
                            'objUser.Manager = strManagerDN
                            strCommand = "cmd /c " & strADMod & " -b """ & objUser.DistinguishedName & """ ""manager::" & strManagerDN & """"
                            objShell.Run strCommand, 0, True
                        End If
                    ElseIf objUser.Manager <> "" And strManager = "" 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
                    ElseIf strManager <> "" Then
                        ' Manager was not found, so we clear the manager
                        With Cells(intRow, "BI").Interior
                           .ColorIndex = 3
                           .Pattern = xlSolid
                           .PatternColorIndex = xlAutomatic
                        End With
                        boolChanged = True
                        objUser.PutEx ADS_PROPERTY_CLEAR, "Manager", 0
                    Else
                        ' No change
                        With Cells(intRow, "BI").Interior
                           .ColorIndex = 35
                           .Pattern = xlSolid
                           .PatternColorIndex = xlAutomatic
                        End With
                    End If
                   
                   If boolChanged = True Then
                       objUser.SetInfo
                   End If
                   Set objUser = Nothing
               Else
                   With Cells(intRow, "L").Interior
                   .ColorIndex = 3
                   .Pattern = xlSolid
                   .PatternColorIndex = xlAutomatic
                   End With
               End If
           End If
       Next
       Application.EnableEvents = True
    End If
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

Private Function Find_DNs_With_ADFind(strObjectType, strSearchField, strObjectToGet, strCommaDelimProps)
    strADFind = "N:\Scripting\ADFind.exe"
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objShell = CreateObject("WScript.Shell")
    If objFSO.FileExists(strADFind) = False Then
        MsgBox "Could not find ADFind"
    Else
        strADFind = objFSO.GetFile(strADFind).ShortPath
        strTempOutput = objFSO.GetParentFolderName(strADFind) & "\TempOutput.txt"
        ' First we are going to check the local domain for the object
        strCommand = "cmd /c " & strADFind & " -f ""&(objectclass=" & strObjectType & ")(" & strSearchField & "=" & strObjectToGet & ")"" " & strCommaDelimProps & " > " & strTempOutput
        objShell.Run strCommand, 0, True
        Set objFile = objFSO.OpenTextFile(strTempOutput, 1, False)
        strResult = ""
        While Not objFile.AtEndOfStream
            strLine = objFile.ReadLine
            If Left(LCase(strLine), 6) = "dn:cn=" Then
                If strResult = "" Then
                    strResult = Mid(strLine, 4)
                Else
                    strResult = strResult & ";" & Mid(strLine, 4)
                End If
            End If
        Wend
        objFile.Close
        objFSO.DeleteFile strTempOutput, True
        ' Now if there were no objects found, search the entire forest, which should work cross-domain
        If strResult = "" Then
            strCommand = "cmd /c " & strADFind & " -gcb -f ""&(objectclass=" & strObjectType & ")(" & strSearchField & "=" & strObjectToGet & ")"" " & strCommaDelimProps & " > " & strTempOutput
            objShell.Run strCommand, 0, True
            Set objFile = objFSO.OpenTextFile(strTempOutput, 1, False)
            strResult = ""
            While Not objFile.AtEndOfStream
                strLine = objFile.ReadLine
                If Left(LCase(strLine), 6) = "dn:cn=" Then
                    If strResult = "" Then
                        strResult = Mid(strLine, 4)
                    Else
                        strResult = strResult & ";" & Mid(strLine, 4)
                    End If
                End If
            Wend
            objFile.Close
            objFSO.DeleteFile strTempOutput, True
        End If
    End If
    Find_DNs_With_ADFind = strResult
End Function

Open in new window

Author

Commented:
Hi Rob,
Now the pattern is different
Each time i ran i got this
1. First the local became yellow and the root domain manager green (Both did not update in AD)
2. Both became yellow (None update)
3. Both are yellow ( Only Local got updated)

Author

Commented:
Hi Rob any views...

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial