Макрос, который проверяет, находятся ли группы AD, перечисленные в столбце xls, в Active Directory - PullRequest
0 голосов
/ 08 ноября 2019

У меня есть xls, у которого есть список групп Active Directory в столбце A, и я надеюсь запросить каждую группу, чтобы узнать, существует ли она с тем же именем в Active Directory. У меня есть сценарий VB, который ищет группу и сообщает мне информацию об этом в CSV, но я бегаю кругами, пытаясь заставить это работать для активной электронной таблицы.

Впервые публикую для меня, но большой поклонник сайта и его людей.

Sub CheckForGroups()

' Clear Column B Cells
Range("B4:B1000").Clear

'---Set to read first item in list A4
Dim strgroup As String

Application.ScreenUpdating = True
For introw = 4 To ActiveSheet.Cells(65536, 1).End(xlUp).Row
strgroup = ActiveSheet.Cells(introw, 1).Value


'------------get info and write output in the adjacent cell-------
Set objGroup = GetObject("LDAP://" & GetDN(strgroup))

If Err.Number = "-2147016656" Then
    Check = False
    Err.Clear
Else
    Check = True
End If

If Check(strgroup) = True Then
    ActiveSheet.Cells(introw, 2).Value = objGroup.Name

Else
    ActiveSheet.Cells(introw, 2).Value = "Group not found"

End If

Next

    MsgBox "Group Check Completed"
End Sub

'****************Sub to Get DN of group****************
Function GetDN(strgroup)
Dim objRootDSE, adoCommand, adoConnection
Dim varBaseDN, varFilter, varAttributes
Dim adoRecordset

Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
Set adoCommand.ActiveConnection = adoConnection

' Search entire Active Directory domain.
Set objRootDSE = GetObject("LDAP://RootDSE")
varDNSDomain = objRootDSE.Get("defaultNamingContext")
varBaseDN = "<LDAP://" & varDNSDomain & ">"

' Filter on group objects.
varFilter = "(&(objectClass=group)(|(cn=" & groupName & ")(name=" & groupName & ")))"

' Comma delimited list of attribute values to retrieve.
varAttributes = "distinguishedname"

' Construct the LDAP syntax query.
strQuery = varBaseDN & ";" & varFilter & ";" & varAttributes & ";subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 1000
adoCommand.Properties("Timeout") = 20
adoCommand.Properties("Cache Results") = False

' Run the query till EOF
Set adoRecordset = adoCommand.Execute
If (adoRecordset.EOF <> True) Then
   GetDN = adoRecordset.Fields("distinguishedname").Value
Else
   'End of List
End If

' close ado connections.
adoRecordset.Close
adoConnection.Close

End Function

К сожалению, этот код не работает, так как я хватаюсь за соломинку о том, как собрать его вместе

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...