[DmitriiV]

В качестве примера (для режима GUI):

читать дальше »

Код:

Dim objRoot, strDomain, strOU, objOU, strTemp
Dim objConnection, objCommand, objRSet, strCommandText, strAttributes
Const ADS_SCOPE_SUBTREE = 2

Set objRoot = GetObject("LDAP://RootDSE")
strDomain = objRoot.Get("DefaultNamingContext")
Set objRoot = Nothing
strOU = Trim(InputBox("Имя подразделения:"))
If Len(strOU) > 0 Then
    Set objConnection = CreateObject("ADODB.Connection")
    objConnection.Provider = "ADsDSOObject"
    objConnection.Open "Active Directory Provider"
    Set objCommand = CreateObject("ADODB.Command")
    Set objCommand.ActiveConnection = objConnection
    strAttributes = "distinguishedName"
    strCommandText = "SELECT " & strAttributes & " FROM 'LDAP://" & strDomain & _
            "' WHERE objectCategory='organizationalUnit' AND name='" & strOU & "'"
    objCommand.CommandText = strCommandText
    objCommand.Properties("Page Size") = 1000
    objCommand.Properties("Timeout") = 30
    objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
    Set objRSet = objCommand.Execute
    If objRSet.RecordCount > 0 Then
        strTemp = objRSet.Fields("distinguishedName").Value
        MsgBox "Объект " & UCase(strOU) & " обнаружен:" & vbNewLine & strTemp, vbInformation
        On Error Resume Next
        Set objOU = GetObject("LDAP://" & strTemp)
        If Err.Number = 0 Then
            MsgBox "Привязка к объекту выполнена.", vbInformation
        Else
            MsgBox "Ошибка привязки с кодом " & Err.Number & vbNewLine & Err.Description, vbCritical
            Err.Clear
        End If
        Set objOU = Nothing
        On Error GoTo 0
    Else
        MsgBox "Объект " & UCase(strOU) & " не обнаружен.", vbExclamation
    End If
    Set objRSet = Nothing
    Set objCommand = Nothing
    objConnection.Close
    Set objConnection = Nothing
End If
WScript.Quit 0

[Chugun]

В качестве примера (для режима GUI):

Извините, я пока ещё "начинающий" в изучении скриптов.
можно ли "разжевать" что и куда ?

[DmitriiV]

Не пойму вопроса. Вас интересует инструкция по запуску сценария, комментарии к его коду или что-то иное?

[Chugun]

инструкция по запуску сценария, комментарии к его коду или что-то иное? »

комментарии

я не совсем понимаю как в этом коде происходит определение на существование объекта.
и почему вроде "лёгкое и понятное" условие обрастает таким кол-вом строк...

извините за нубизм

[Iska]

Условие:

Код:

    strCommandText = "SELECT " & strAttributes & " FROM 'LDAP://" & strDomain & _
            "' WHERE objectCategory='organizationalUnit' AND name='" & strOU & "'"
    …
    If objRSet.RecordCount > 0 Then

и так простое и понятное.

[Chugun]

strCommandText = "SELECT " & strAttributes & " FROM 'LDAP://" & strDomain & _ "' WHERE objectCategory='organizationalUnit' AND name='" & strOU & "'" … Set objRSet = objCommand.Execute If objRSet.RecordCount > 0 Then »

это поиск по всему домену или конкретному контейнеру ?

[DmitriiV]

не совсем понимаю как в этом коде происходит определение на существование объекта...

С помощью запроса на поиск (SELECT) в базе данных AD (FROM 'LDAP://" & strDomain) объекта заданного типа (objectCategory='organizationalUnit') с заданным именем (name='" & strOU & "'").
Вывод о результативности поиска делается на основе подсчёта найденных в базе данных записей
(If objRSet.RecordCount > 0 Then).

... почему вроде "лёгкое и понятное" условие обрастает таким кол-вом строк

Потому что таковы правила оформления соответствующего запроса к базе данных.
Можно, конечно, упростить сценарий, отказавшись от использования ADO в пользу попытки прямой привязки к объекту с последующим анализом состояния генератора ошибок. Например:

Код:

Set objRoot = GetObject("LDAP://RootDSE")
strDomain = objRoot.Get("DefaultNamingContext")
Set objRoot = Nothing
strOU = "ou=Test," & strDomain
On Error Resume Next
Set objOU = GetObject("LDAP://" & strOU)
If Err.Number = 0 Then
    MsgBox "Привязка к объекту выполнена.", vbInformation
Else
    MsgBox "Ошибка привязки с кодом " & Err.Number & vbNewLine & Err.Description, vbCritical
    Err.Clear
End If
Set objOU = Nothing

Можно, наконец, исключить из кода и процедуру определения имени домена:

Код:

On Error Resume Next
Set objOU = GetObject("LDAP://ou=Test,dc=MDM,dc=COM")
If Err.Number = 0 Then
    MsgBox "Привязка к объекту выполнена.", vbInformation
Else
    MsgBox "Ошибка привязки с кодом " & Err.Number & vbNewLine & Err.Description, vbCritical
    Err.Clear
End If
Set objOU = Nothing

Однако здесь требуется точно знать путь к целевому объекту в структуре "дерева" AD, что не всегда приемлемо. Кстати, ошибка привязки может возникнуть не только из-за того, что искомый объект отсутствует, поэтому, по-хорошему, здесь понадобится знание кода соответствующей ошибки, а также уверенность в том, что путь к объекту указан верно.

это поиск по всему домену или конкретному контейнеру ?

В данном примере по всему домену.

[Iska]

это поиск по всему домену или конкретному контейнеру ? »

Set objRoot = GetObject("LDAP://RootDSE") strDomain = objRoot.Get("DefaultNamingContext") … … FROM 'LDAP://" & strDomain & … »

[Chugun]

On Error Resume Next Set objOU = GetObject("LDAP://ou=Test,dc=MDM,dc=COM") If Err.Number = 0 Then MsgBox "Привязка к объекту выполнена.", vbInformation Else MsgBox "Ошибка привязки с кодом " & Err.Number & vbNewLine & Err.Description, vbCritical Err.Clear End If Set objOU = Nothing »

этот вариант, имхо, будет в моём случае наиболее актуальным.
я знаю полный путь к OU, ведь структуру составляю сам и там всё жестко.

у меня есть сотрудники и ученики.
сотрудники не меняются практически никогда (вот уже 10 с лишним лет)
а ученики - каждые полгода надо создавать новые группы пользователей.
скрипт на создание группы был написан "до меня", предыдущим Одмином, и работает корректно.
одна заковырка - перед созданием группы пользователей надо ручками создать OU для неё.

решил доработать в сторону ещё большей автоматизации.

Спасибо за помощь!