Comparer Openldap avec une liste existante

Bonjour,

j'ai une macro qui fonctionne bien et me rempli ma liste avec toutes les infos d'Openldap.

J'aimerais bien qu'à chaque fois quand j'utilise la macro qu'elle fasse une comparaison entre Openldap et ma liste existante et me réalise le suivant:

1- si un utilisateur existe, et sous openldap et sous ma feuille excel ==> il m'affiche sous la colonne E ==> actif

2- si un utilisateur n'existe que sous ma feuille excel ==> il m'affiche sous la colonne E ==> inactif (sans l'effacer)

3- si un utilisateur n'existe que sous Openldap (il est nouveau) ==> il m'affiche sous la colonne E ==> nouveau (en l'ajoutant aprés la derniere ligne existante)

Merci d'avance pour votre aide!

Voici la macro ( l'Openldap que j'ai utilisé ici est ouvert pour tout le monde ==> https://www.forumsys.com/tutorials/integration-how-to/ldap/online-ldap-test-server/)

Sub Connect_01()
Dim arrAttrs, arrLabels
arrAttrs = Array("cn", "givenname", "mail", "uid")
arrLabels = Array("Nom", "Prenom", "E-Mail", "UID")

' Setup Excel object
Set objExcel = ThisWorkbook.Worksheets("Sheet1")
objExcel.Visible = True

' Create header row with attribute labels
For i = 0 To UBound(arrAttrs)
objExcel.Cells(1, i + 1).Value = arrLabels(i)
Next

' Setup connection to LDAP server
Const ADS_SCOPE_SUBTREE = 2
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "'CompanyNameHere' LDAP Directory"
Set objCommand.ActiveConnection = objConnection
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE

' Construct database query
objCommand.CommandText = "SELECT " & Join(arrAttrs, ",") & " FROM 'LDAP://ldap.forumsys.com:389/dc=example,dc=com' " & " WHERE objectclass='*' "

' Execute the database query and write results to Excel object
Set objRecordSet = objCommand.Execute
objRecordSet.MoveFirst

' start writing at the second row
x = 2
Do Until objRecordSet.EOF
For i = 0 To UBound(arrAttrs)
objExcel.Cells(x, i + 1).Value = objRecordSet.Fields(arrAttrs(i)).Value
Next
x = x + 1
objRecordSet.MoveNext
Loop
End Sub

Slt,

j'ai réussi à realiser ce que je cherche. ça pourrait peut être intéresser quelqu'un

Sub Retrieve_LDAP_Data()
Dim rng As Range
Dim iLast, iLast_Temp, lastRow As Long
Dim iCounter As Integer
Dim arrAttrs, arrLabels
arrAttrs = Array("cn", "givenname", "mail", "uid")
arrLabels = Array("Nom", "Prenom", "E-Mail", "UID")

' Setup Excel object
Set objExcel = ThisWorkbook.ActiveSheet
objExcel.Visible = True

' Create header row with attribute labels
For i = 0 To UBound(arrAttrs)
    objExcel.Cells(1, i + 10).Value = arrLabels(i)
Next

' Setup connection to LDAP server
Const ADS_SCOPE_SUBTREE = 2
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "'CompanyNameHere' LDAP Directory"
Set objCommand.ActiveConnection = objConnection
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE

' Construct database query
objCommand.CommandText = "SELECT " & Join(arrAttrs, ",") & " FROM 'LDAP://ldap.forumsys.com:389/dc=example,dc=com' " & " WHERE objectclass='*' "

' Execute the database query and write results to Excel object
Set objRecordSet = objCommand.Execute
objRecordSet.MoveFirst

' start writing at the second row in the Temp-Range
x = 2
Do Until objRecordSet.EOF
    For i = 0 To UBound(arrAttrs)
        objExcel.Cells(x, i + 10).Value = objRecordSet.Fields(arrAttrs(i)).Value
    Next
    x = x + 1
    objRecordSet.MoveNext
Loop

' Copy and Paste from the temp_Range to the right range
iLast_Temp = Range("J" & Application.Rows.Count).End(xlUp).Row
    For iCounter = 2 To iLast_Temp
        Set rng = Range("A:A").Find(Range("J" & iCounter).Value)
            If rng Is Nothing Then
                lastRow = Cells(Rows.Count, "A").End(xlUp).Row + 1
                Range("J" & iCounter & ":M" & iCounter).Copy
                Range("A" & Range("A" & Application.Rows.Count).End(xlUp).Row + 1).PasteSpecial xlPasteAll
                Cells(lastRow, 5).Value = "New"
                Range("A" & lastRow & ":E" & lastRow).Interior.ColorIndex = 37
             Else
                Cells(iCounter, 5).Value = "activ"
                Range("A" & iCounter & ":E" & iCounter).Interior.ColorIndex = 0
             End If
    Next iCounter

iLast = Range("A" & Application.Rows.Count).End(xlUp).Row
    For iCounter = 2 To iLast
        Set rng = Range("J:J").Find(Range("A" & iCounter).Value)
            If rng Is Nothing Then
                Cells(iCounter, 5).Value = "inactiv"
                Range("A" & iCounter & ":E" & iCounter).Interior.ColorIndex = 22
            End If
    Next iCounter

' Clear the temp_Range
Range("J:M").Clear
End Sub

Bonne nuit