Excel VBA how to find a description from an AD-group

Question

I have to create an Excel spreadsheet for a project that suggests new Active Directory groups based on the users' existing Active Directory groups. I require the active directory group's current description column for this (this is a mandatory field in our organization).

As a result, I already have a script that can confirm the presence of a Group by colouring it in. It's just one step in a larger problem. The description information is not retrieved in this way. Also, I haven't yet discovered a practical answer on the internet that I could also understand. The fact that the groups are in several Containers is a challenge that could make it more complicated. The distinguishing name prefix becomes inconsistent as a result.

Code so far. This reads ADgroups from column D (starting with D2) and searches it in active directory. Then it marks a cell with the colour green if it was found.

Sub ValidateGroupName()

Dim objController
Dim objGCController
Dim objConnection
Dim objCommand
Dim strADPath
Dim objRecordSet
Dim objFields

Dim Y As Integer
Dim GroupName As String
Dim ActSheet As String
Dim Descriptionname As String

ActSheet = ActiveSheet.Name

' Set up AD connection

Set objConnection = CreateObject("ADODB.Connection")
    objConnection.Open "Provider=ADsDSOObject;"

Set objCommand = CreateObject("ADODB.Command")
    objCommand.ActiveConnection = objConnection

Set objController = GetObject("GC:")

' Get record from AD

For Each objGCController In objController
    strADPath = objGCController.ADspath
    'strADDescription = objGCController.ADspath
Next


Y = 0
Do

GroupName = Sheets(ActSheet).Range("D2").Offset(Y, 0).Value

    objCommand.CommandText = _
    "<" & strADPath & ">;(&(objectClass=Group)" & _
         "(cn=" & GroupName & "));distinguishedName;subtree"
         

objCommand.Properties("Page Size") = 50000
Set objRecordSet = objCommand.Execute
    
' What to do with results?
If objRecordSet.RecordCount = 0 Then
'change color of a cell to red
Sheets(ActSheet).Range("E2").Offset(Y, 0).Interior.Color = 255
Else
' change color of a cell to green
Sheets(ActSheet).Range("E2").Offset(Y, 0).Interior.Color = 7138816
End If

Y = Y + 1

Loop Until Sheets(ActSheet).Range("D2").Offset(Y, 0).Value = ""

' Close AD connection
    objConnection.Close

End Sub

I hope I'm on the right track, but a different approach might be a cleaner solution.

Answer 1

First add the 'description' property to your query :

objCommand.CommandText = _
    "<" & strADPath & ">;(&(objectClass=Group)" & _
         "(cn=" & GroupName & "));distinguishedName;subtree;Description"

Then, get the property value if the group exists and write it beside the group cell for example :

If objRecordSet.RecordCount = 0 Then
'change color of a cell to red
Sheets(ActSheet).Range("E2").Offset(Y, 0).Interior.Color = 255
Else
' change color of a cell to green
Sheets(ActSheet).Range("E2").Offset(Y, 0).Interior.Color = 7138816
Sheets(ActSheet).Range("E2").Offset(Y, 1).text = objRecordset.Fields("Description")
End If