[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