[DmitriiV]

Например, так:

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

Код:

Dim objRoot, objConnection, objCommand, objRSet, objUser
Dim objFS, objFile, objWShell, strLog, strItem, strList, strTemp, arrTemp
Dim strAttributes, strAttributesAdd
strLog = "Users_Computers.txt"
Set objRoot = GetObject("LDAP://RootDSE")
strDomain = objRoot.Get("DefaultNamingContext")
Set objRoot = Nothing
strAttributes = "cn,whenCreated"
strAttributesAdd = ",mail,distinguishedName"
arrCmdText = Array("<LDAP://" & strDomain & ">;(&(objectCategory=Person)(objectClass=User));" & _
                    strAttributes & strAttributesAdd & ";Subtree", _
                    "<LDAP://" & strDomain & ">;(objectCategory=Computer);" & strAttributes & ";Subtree")
arrCapLines = Array("|Пользователь|Дата создания|Адрес эл. почты|Членство в группах", "|Компьютер|Дата создания|")
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand = CreateObject("ADODB.Command")
Set objCommand.ActiveConnection = objConnection
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Timeout") = 30
objCommand.Properties("Sort On") = "cn"
Set objFS = CreateObject("Scripting.FileSystemObject")
strLog = objFS.BuildPath(objFS.GetParentFolderName(WScript.ScriptFullName), strLog)
Set objFile = objFS.CreateTextFile(strLog, True)
On Error Resume Next
For i = 0 To UBound(arrCmdText)
    objCommand.CommandText = arrCmdText(i)
    Set objRSet = objCommand.Execute
    If Err.Number = 0 Then
        If objRSet.RecordCount > 0 Then
            objFile.WriteLine (arrCapLines(i))
            objRSet.MoveFirst
            Do Until objRSet.EOF
                strItem = "|" & objRSet.Fields("cn").Value & "|" & DateValue(objRSet.Fields("whenCreated").Value) & "|"
                If InStr(1, arrCmdText(i), "objectClass=User", vbTextCompare) > 0 Then
                    strTemp = objRSet.Fields("mail").Value
                    If Err.Number = 0 Then
                        strItem = strItem & strTemp & "|"
                    Else
                        Err.Clear
                    End If
                    Set objUser = GetObject("LDAP://" & objRSet.Fields("distinguishedName").Value)
                    If Err.Number = 0 Then
                        strList = vbNullString
                        arrTemp = objUser.GetEx("memberOf")
                        If Err.Number = 0 Then
                            For Each strTemp In arrTemp
                                strTemp = Mid(Split(strTemp, ",")(0), 4)
                                strList = strList & strTemp & ";"
                            Next
                            strItem = strItem & strList
                        Else
                            strItem = strItem & "Значение атрибута MEMBEROF не определено"
                            Err.Clear
                        End If
                    Else
                        strItem = strItem & "Членство в группах не определено"
                        Err.Clear
                    End If
                    objFile.WriteLine strItem
                Else
                    objFile.WriteLine strItem
                End If
                objRSet.MoveNext
            Loop
            Set objUser = Nothing
        End If
    Else
        objFile.WriteLine "Ошибка " & Err.Number & " (" & Err.Description & ")" & vbNewLine & _
                            " при выполнении запроса: " & arrCmdText(i)
        Err.Clear
    End If
    If i < UBound(arrCmdText) Then objFile.WriteLine
Next
objFile.Close
Set objFile = Nothing
Set objFS = Nothing
Set objRSet = Nothing
Set objCommand = Nothing
objConnection.Close
Set objConnection = Nothing
Set objWShell = CreateObject("WScript.Shell")
objWShell.Run "notepad.exe " & strLog, 1
Set objWShell = Nothing
WScript.Quit 0