The script updates the AD with the data in the excel. Active directory.

Sub Update_Seat_And_Extension_In_AD_From_Excel()
'Check the desktops sheet with AD and update
'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 = "CK" Then
                    strArea = " (044-321"
                ElseIf strBuilding = "PK" Then
                    strArea = " (044-32"
                Else
                    strArea = " (044-381"
                End If
                
                If UCase(objuser.telephoneNumber) <> UCase("Ext:" & strExt & strArea & strExt & ") (" & strSeatNo & ")") Then
                    With Cells(intRow, "D").Interior
                        .ColorIndex = 36
                        .Pattern = xlSolid
                        .PatternColorIndex = xlAutomatic
                    End With
                    boolChanged = True
                    If strExt <> "" Then
                        objuser.telephoneNumber = UCase("Ext:" & strExt & strArea & strExt & ") (" & strSeatNo & ")")
                    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

Select allOpen in new window