holydiver пишет:... Мне надо указать, например, так:
set objParent = GetObject("LDAP://ou=домен,dc=domain,dc=local")...
Пример относительной привязки к родительскому контейнеру заданного контейнера:
Set objRoot = GetObject("LDAP://RootDSE")
Set objContainer = GetObject("LDAP://cn=Computers," & objRoot.Get("DefaultNamingContext"))
Set objParent = GetObject(objContainer.Parent)
MsgBox objParent.ADsPath
Ну, и "до кучи" пример рекурсивного просмотра содержимого AD:
'Создание списка отключенных учётных записей пользователей домена
'путём рекурсивного просмотра "дерева" Active Ditectory.
'Отчёт оформляется в виде двух файлов: HTML-страницы и рабочей книги Excel.
'Сценарий ориентирован на работу в графическом режиме.
Dim objRoot, objContainer, objItem
Dim objFS, objFile, objExcel, objWB, objApp
Dim strHTMLText, intCounter, intMaxCells, strTemp, strLog, strBook, strName
Dim arrTemp, arrRecords()
Const strArgToOperation = ""
Const strOperation = "open"
Const intShowMode = 1 'Нормальные настройки положения и размера окна
strLog = "Disabled_Users.htm"
strName = strLog
strBook = "Disabled_Users.xls"
Set objFS = CreateObject("Scripting.FileSystemObject")
strLog = objFS.BuildPath(objFS.GetParentFolderName(WScript.ScriptFullName), strLog)
strBook = objFS.BuildPath(objFS.GetParentFolderName(WScript.ScriptFullName), strBook)
Set objRoot = GetObject("LDAP://rootDSE")
Set objContainer = GetObject("LDAP://" & objRoot.Get("defaultNamingContext"))
Set objRoot = Nothing
intCounter = 0: intMaxCells = 0: strHTMLText = vbNullString
strHTMLText = "<html><title>Отчет об отключенных учетных записях</title><body>" & vbNewLine & _
"<h2>Отчет об отключенных учетных записях (по состоянию на " & Date & ")" & "</h2>" & vbNewLine
Set objExcel = CreateObject("Excel.Application")
Set objWB = objExcel.Workbooks.Add
objWB.Worksheets(1).Cells(1, 1).Value = "Отчет об отключенных учетных записях (по состоянию на " & Date & ")"
For Each objItem In objContainer
strTemp = objItem.Class
If StrComp(strTemp, "organizationalUnit", vbTextCompare) = 0 Or _
StrComp(strTemp, "container", vbTextCompare) = 0 Then
Call Get_Members(objItem, objWB, intCounter, intMaxCells, arrRecords)
End If
Next
Set objItem = Nothing
Set objContainer = Nothing
objWB.Worksheets(1).Cells(intCounter + 4, 1).Value = "Всего " & intCounter & " отключено."
objWB.Worksheets(1).Columns.AutoFit
objExcel.DisplayAlerts = False
objWB.SaveAs strBook
objExcel.Quit
Set objWB = Nothing
Set objExcel = Nothing
strHTMLText = strHTMLText & "<table width=100% border=1 cellspacing=0 cellpadding=2>" & vbNewLine
For i = 0 To intCounter - 1
strHTMLText = strHTMLText & "<tr>" & vbNewLine
arrTemp = Split(arrRecords(i), ",")
For j = 0 To intMaxCells
If j <= UBound(arrTemp) Then
strHTMLText = strHTMLText & "<td>" & Mid(arrTemp(j), 4) & "</td>" & vbNewLine
Else
strHTMLText = strHTMLText & "<td>*</td>" & vbNewLine
End If
Next
strHTMLText = strHTMLText & "</tr>" & vbNewLine
Next
strTemp = objFS.GetParentFolderName(WScript.ScriptFullName)
strHTMLText = strHTMLText & "</table>" & "<br>" & vbNewLine
strHTMLText = strHTMLText & "Всего <b>" & intCounter & "</b> отключено."
strHTMLText = strHTMLText & "</body></html>"
Set objFS = CreateObject("Scripting.FileSystemObject")
Set objFile = objFS.CreateTextFile(strLog, True)
objFile.Write strHTMLText
objFile.Close
Set objFile = Nothing
Set objFS = Nothing
'WScript.Echo "Списки созданы."
Set objApp = CreateObject("Shell.Application")
objApp.ShellExecute strName, strArgToOperation, strTemp, strOperation, intShowMode
Set objApp = Nothing
WScript.Quit 0
'=====
Function Get_Members(objOU, objWB, intCount, intCells, arrRec)
Dim objItem, objUser, strTemp, arrTemp
For Each objItem In objOU
strTemp = objItem.Class
If StrComp(strTemp, "user", vbTextCompare) = 0 Then
Set objUser = GetObject(objItem.ADsPath)
If objUser.AccountDisabled Then
strTemp = Mid(objUser.ADsPath, 8)
arrTemp = Split(strTemp, ",")
If UBound(arrTemp) > intCells Then
intCells = UBound(arrTemp)
End If
ReDim Preserve arrRec(intCount)
arrRec(intCount) = strTemp
For i = 0 To intCells
If i <= UBound(arrTemp) Then
objWB.Sheets(1).Cells(intCount + 3, i + 1).Value = Mid(arrTemp(i), 4)
End If
Next
Erase arrTemp
intCount = intCount + 1
End If
Set objUser = Nothing
Else
If StrComp(strTemp, "organizationalUnit", vbTextCompare) = 0 Or _
StrComp(strTemp, "container", vbTextCompare) = 0 Then
Call Get_Members(objItem, objWB, intCount, intCells, arrRec)
End If
End If
Next
Set objItem = Nothing
End Function
