Вытаскивание информации из Active Directory по пользователям на WMI и WHS

Перед тем как выполнять скрипт необходимо поправить строку:
Str_LDAP= "LDAP://CN="& StrGroupName &",OU=ASU,OU=Contora,DC=corp,DC=domain,DC=ru"
под свои нужды.
Для выполнения скрипта в домене и сбора множественной информации привелегии не нужны, можно выполнять из-под рядового пользователя домена. Я бы сказал, что это шпионский скрипт )))
содержимое файла .vbs(работает из под Windows XP в доменах с уровнями домена и леса: Windows 2003, Windows 2008, Windows 2008 R2):

'***************************************************************
'Getting information about users from Active Directory
'***************************************************************
' НАЧАЛО ФРАГМЕНТА A
Dim objArgs, strGroupDN, StrGroupName, MyFileName1, Str_LDAP
set objArgs = WScript.Arguments
StrGroupName = "ALL Users"
Str_LDAP= "LDAP://CN="& StrGroupName &",OU=ASU,OU=Contora,DC=corp,DC=domain,DC=ru"
if objArgs.Count <> 1 then
Dim objRootDSE
set objRootDSE = GetObject("LDAP://RootDSE")
strGroupDN = Str_LDAP '& objRootDSE.Get("defaultNamingContext")
Else
strGroupDN = objArgs.Item(0)
end if
' КОНЕЦ ФРАГМЕНТА A
MyFileName1 = GetScriptDirectory & "Члены группы - " & StrGroupName & ".txt"
'***************************************************************
' НАЧАЛО ФРАГМЕНТА B
Dim dicSeenGroupMember
set dicSeenGroupMember = CreateObject("Scripting.Dictionary")
FuncAppendOneStrToTXTFile MyFileName1, "Members of " & strGroupDN & ":"
DisplayMembers strGroupDN, " ", dicSeenGroupMember
Wscript.Echo "Сбор данных о членах группы <" & StrGroupName & "> - завершен" & Chr(10) & "Отчет находится в файле " & MyFileName1 & Chr(10) & "The End"
' КОНЕЦ ФРАГМЕНТА B
'***************************************************************
'----------------функция----------------------------------------
Function DisplayMembers (strGroupADsPath, strSpaces, dicSeenGroupMember)

FuncAppendOneStrToTXTFile MyFileName1,"ФИО" & vbTab & "CanonicalName" & vbTab & "userPrincipalName" & vbTab & "LDAP" & vbTab & "OU Native" & vbTab & "phisicalDeliveryOfficeName" & vbTab & "Description" & vbTab & "Mail" & vbTab & "scriptPath" & vbTab & "homeDirectory" & vbTab & "homeDrive" & vbTab & "telephoneNumber" & vbTab & "homeMDB" & vbTab & "logonCount" & vbTab & "lastLogon" & vbTab & "whenCreated" & vbTab & "UserAccountControl" & vbTab & "badPwdCount" & vbTab & "badPasswordTime" & vbTab & "pwdLastSet" & vbTab & "msNPAllowDialin" & vbTab & "msRTCSIP-PrimaryUserAddress" & vbTab & "msRTCSIP-LineServer" & vbTab & "msRTCSIP-Line"
Dim objGroup, objMember, oG, Obj, UserObj
set objGroup = GetObject(strGroupADsPath)
for each objMember In objGroup.Members
FuncAppendOneStrToTXTFile MyFileName1, GetToFileOneCNFromAD(objMember.Get("distinguishedname"))
if objMember.Class = "group" then
if dicSeenGroupMember.Exists(objMember.ADsPath) then
Wscript.Echo strSpaces & " ^ already seen group member " & "(stopping to avoid loop)"
FuncAppendOneStrToTXTFile MyFileName1, strSpaces & " ^ already seen group member " & "(stopping to avoid loop)"
else
dicSeenGroupMember.Add objMember.ADsPath, 1
DisplayMembers objMember.ADsPath, strSpaces & " ", dicSeenGroupMember
end if
end if
Next
End Function
'----------------функция----------------------------------------
Function GetToFileOneCNFromAD(StrLDAP)
GetToFileOneCNFromAD = ""
'-------- результат запроса возвращаем в переменную oGroup
Set Obj = GetObject("LDAP://" & StrLDAP)
On Error Resume Next
OU_Native = Mid(Obj.ADsPath, InStr(1,Obj.ADsPath, "OU"))
if (Err.Number = 0) Then
OU_Native = Mid(Obj.ADsPath, InStr(1,Obj.ADsPath, "OU"))
Else
OU_Native = Obj.ADsPath
Err.Clear
End If
GetToFileOneCNFromAD = Mid(Obj.Name,4,Len(Obj.Name)-3) & vbTab & Obj.Name & vbTab & Obj.userPrincipalName & vbTab & Obj.ADsPath & vbTab & OU_Native & vbTab & Obj.physicalDeliveryOfficeName & vbTab & Obj.description & vbTab & Obj.mail & vbTab & Obj.scriptPath & vbTab & Obj.homeDirectory & vbTab & Obj.homeDrive & vbTab & Obj.telephoneNumber & vbTab & Obj.homeMDB & vbTab & Obj.logonCount & vbTab & FuncConvertTimeStamp( FuncConvertTime(Obj.lastLogon) ) & vbTab & Obj.whenCreated & vbTab & Obj.UserAccountControl & vbTab & Obj.badPwdCount & vbTab & FuncConvertTimeStamp( FuncConvertTime(Obj.badPasswordTime)) & vbTab & FuncConvertTimeStamp( FuncConvertTime(Obj.pwdLastSet)) & vbTab & Obj.msNPAllowDialin & vbTab & GetSIPContact(Obj)
' GetToFileOneCNFromAD = Mid(Obj.Name,4,Len(Obj.Name)-3) & vbTab & Obj.Name & vbTab & Obj.userPrincipalName & vbTab & Obj.ADsPath & vbTab & OU_Native & vbTab & Obj.physicalDeliveryOfficeName & vbTab & Obj.description & vbTab & Obj.mail & vbTab & Obj.scriptPath & vbTab & Obj.homeDirectory & vbTab & Obj.homeDrive & vbTab & Obj.telephoneNumber & vbTab & Obj.homeMDB & vbTab & Obj.logonCount & vbTab & FuncConvertTimeStamp( FuncConvertTime(Obj.lastLogon) ) & vbTab & Obj.whenCreated & vbTab & Obj.UserAccountControl & vbTab & Obj.badPwdCount & vbTab & FuncConvertTimeStamp( FuncConvertTime(Obj.badPasswordTime)) & vbTab & FuncConvertTimeStamp( FuncConvertTime(Obj.pwdLastSet)) & vbTab & GetSIPContact(Obj)
' GetToFileOneCNFromAD = Mid(Obj.Name,4,Len(Obj.Name)-3) & vbTab & Obj.Name & vbTab & Obj.userPrincipalName & vbTab & Obj.ADsPath & vbTab & Obj.physicalDeliveryOfficeName & vbTab & Obj.description & vbTab & Obj.mail & vbTab & Obj.scriptPath & vbTab & Obj.homeDirectory & vbTab & Obj.homeDrive & vbTab & Obj.telephoneNumber & vbTab & Obj.homeMDB & vbTab & Obj.logonCount & vbTab & FuncConvertTimeStamp( FuncConvertTime(Obj.lastLogon) ) & vbTab & Obj.whenCreated & vbTab & Obj.UserAccountControl & vbTab & Obj.badPwdCount & vbTab & FuncConvertTimeStamp( FuncConvertTime(Obj.badPasswordTime)) & vbTab & FuncConvertTimeStamp( FuncConvertTime(Obj.pwdLastSet)) & vbTab & GetSIPContact(Obj)
End Function
'----------------функция----------------------------------------
'---функция берет информацию об SIP свойствах учетных записей --
Function GetSIPContact( objUser)
On Error Resume Next
objUser.Get("msRTCSIP-PrimaryUserAddress")
if (Err.Number = 0) Then
SIPName=objUser.Get("msRTCSIP-PrimaryUserAddress") & vbTab & objUser.Get("msRTCSIP-LineServer") & vbTab & objUser.Get("msRTCSIP-Line")
MyResult = SIPName
Else
GetSIPContact = ""
Err.Clear
MyResult = vbTab & vbTab & vbTab
End If
GetSIPContact = MyResult

End Function
'----------------функция----------------------------------------
'добавляет строчку в текстовый файл
Function FuncAppendOneStrToTXTFile(FileName, StrText)
'------------------------Константы для задания типа открытия файла
Const ForReading = 1, ForWriting = 2, ForAppending = 8, OverwriteTrue = True, OverwriteFalse = False
' Объявляем переменные
Dim objFSO, FOut
' Создаем объект FileSystemObject
Set objFSO=WScript.CreateObject("Scripting.FileSystemObject")
' Открываем выходной файл для записи
Set FOut = objFSO.OpenTextFile (FileName,ForAppending,true)
' Записываем текстовую строку в файл
FOut.WriteLine StrText' & vbcrlf
' Закрываем выходной файл
FOut.Close
FuncAppendOneStrToTXTFile = true
End Function
'----------------функция----------------------------------------
'создает txt - файл 'файл не должен быть создан
Function FuncCreateTXTFile(FileName)
'------------------------Константы для задания типа открытия файла
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Const OverwriteTrue = True, OverwriteFalse = False, UnicodeTrue = True, UnicodeFalse = False
Const ReadOnlyDeletionTrue = True, ReadOnlyDeletionFalse = False
' Объявляем переменные
Dim objFSO, FOut
' Создаем объект FileSystemObject
Set objFSO=WScript.CreateObject("Scripting.FileSystemObject")
' Открываем выходной файл для записи
Dim File
Set File = objFSO.CreateTextFile(FileName, OverwriteTrue,UnicodeFalse)
' Закрываем выходной файл
FuncCreateTXTFile = true
End Function
'----------------функция----------------------------------------
Function GetScriptDirectory()
Dim WshShell
Set WshShell = CreateObject("WScript.Shell")
GetScriptDirectory = Mid(WScript.ScriptFullName,1,Len(WScript.ScriptFullName)-Len(WScript.ScriptName))
End Function
'----------------функция----------------------------------------
'функция преобразует дату из числового формата в нормальный
Function FuncConvertTime(x)
Dim StrResult, objShell
' Получение настроек о зонах времени из регистра
Set objShell = CreateObject("Wscript.Shell")
lngBiasKey = objShell.RegRead("HKLM\System\CurrentControlSet\Control\" & "TimeZoneInformation\ActiveTimeBias")
If UCase(TypeName(lngBiasKey)) = "LONG" Then
lngBias = lngBiasKey
ElseIf UCase(TypeName(lngBiasKey)) = "VARIANT()" Then
lngBias = 0
For k = 0 To UBound(lngBiasKey)
lngBias = lngBias + (lngBiasKey(k) * 256^k)
Next
End If
On Error Resume Next
Set objDate = x'lastLogon'lngDate
If Err.Number <> 0 Then
On Error GoTo 0
dtmDate = #1/1/1601#
Else
On Error GoTo 0
lngHigh = objDate.HighPart
lngLow = objDate.LowPart
If lngLow <>
lngHigh = lngHigh + 1
End If
If (lngHigh = 0) And (lngLow = 0 ) Then
StrResult = #1/1/1601#
Else
StrResult = #1/1/1601# + (((lngHigh * (2 ^ 32)) + lngLow)/600000000 - lngBias)/1440
End If
End If
'WScript.Echo StrResult
FuncConvertTime = StrResult
End Function
'----------------функция----------------------------------------
'функция преобразует TimeStamp возвращенный функцией FuncConvertTime(x) в поддающийся сортировке TimeStamp
Function FuncConvertTimeStamp(x)
Dim y,z
y = ""
If ( Len(x)>0 ) Then
'проверка на наличие времени в TimeStamp
If (Len(x) > 11) Then
z = Mid(x,12,Len(x)-11)
End If
'преобразование TimeStamp
If Mid(x,13,1) = ":" Then
y = Mid(x,7,4) & "." & Mid(x,4,2) & "." & Mid(x,1,2) & " " & "0" & z
Else
y = Mid(x,7,4) & "." & Mid(x,4,2) & "." & Mid(x,1,2) & " " & z
End If
'y = Mid(x,7,4) & "." & Mid(x,4,2) & "." & Mid(x,1,2) & "." & Mid() & "." & Mid() & "." & Mid()
End If
FuncConvertTimeStamp = y
End Function

Конечно, теперь есть и другое решение:
http://shss.wordpress.com/2010/07/08/ad-add-telephone-numbers-using-excel-application-as-data-soutce/

просто мой скрипт писался, когда ещё не было Power Shell