суббота, 12 марта 2011 г.

Выгрузка данных из AD в Excel скриптом VBS


Вот Сам скрипт VBS на вынос данных.


Option Explicit
Dim objRootDSE, strDNSDomain, strBaseDim adoCommand, adoConnection, objRS, strFilter, strAttributes, strQueryDim objExcel, strName, strPhone, strMail, strOtherphone, arrOtherPhone, strItemDim strsAMAccountName,strTitle,strDepartment,strMobile,strHomePhone

On Error Resume Next
strDNSDomain = "OU=чччччч, DC=чччч, DC=чччч"

Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = adoConnection

Set objExcel = WScript.CreateObject("Excel.Application")
objExcel.Visible = False
objExcel.Workbooks.Add


objExcel.ActiveSheet.Name = "Users " & Left(strDNSDomain,19) & "..."
objExcel.ActiveSheet.Range("A1").Activate

objExcel.ActiveCell.Value = "ФИО пользователя"    
objExcel.ActiveCell.Offset(0,1).Value = "Должность"    
objExcel.ActiveCell.Offset(0,2).Value = "Отдел"    
objExcel.ActiveCell.Offset(0,3).Value = "Городской телефон"
objExcel.ActiveCell.Offset(0,4).Value = "Внутренний телефон"
objExcel.ActiveCell.Offset(0,5).Value = "Мобильный телефон"
objExcel.ActiveCell.Offset(0,6).Value = "Домашний телефон"
objExcel.ActiveCell.Offset(0,7).Value = "Учётная запись"
objExcel.ActiveCell.Offset(0,8).Value = "Электронная почта"
objExcel.ActiveCell.Offset(1,0).Activate                'переход на следующую строку.


strBase = ""
strFilter = "(&(objectCategory=person)(objectClass=user))"
'strAttributes = "name,mail,telephoneNumber,otherTelephone"
strAttributes = "displayName,sAMAccountName,title,department,mail,telephoneNumber,otherTelephone,mobile,homePhone"


' Формеруем строку запроса.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"

' Выполним запрос.
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 307
adoCommand.Properties("Cache Results") = False
Set objRS = adoCommand.Execute


While not objRS.EOF

strName = objRS.Fields("displayName").Value
strMail = objRS.Fields("mail").value
strPhone = objRS.Fields("telephoneNumber").Value
strsAMAccountName = objRS.Fields("sAMAccountName").Value
strTitle = objRS.Fields("title").Value
strDepartment = objRS.Fields("department").Value
strMobile = objRS.Fields("mobile").Value
strHomePhone = objRS.Fields("homePhone").Value
arrOtherPhone = objRS.Fields("otherTelephone").Value
If IsNull(arrOtherPhone) Then
strOtherPhone = ""
Else
strOtherPhone = ""
For Each strItem In arrOtherPhone
If (strOtherPhone = "") Then
strOtherPhone = strItem
Else
strOtherPhone = strOtherPhone & ", " & strItem
End If
Next
End If

'Заполним поля
objExcel.ActiveCell.Value = strName
objExcel.ActiveCell.Offset(0,1).Value = strTitle
objExcel.ActiveCell.Offset(0,2).Value = strDepartment
objExcel.ActiveCell.Offset(0,3).Value = strPhone
objExcel.ActiveCell.Offset(0,4).Value = strOtherPhone
objExcel.ActiveCell.Offset(0,5).Value = strMobile
objExcel.ActiveCell.Offset(0,6).Value = strHomePhone
objExcel.ActiveCell.Offset(0,7).Value = strsAMAccountName
objExcel.ActiveCell.Offset(0,8).Value = strMail
objExcel.ActiveCell.AutoFormat
objExcel.ActiveCell.Offset(1,0).Activate

objRS.MoveNext
Wend

' Чистим память.
Set objRS = Nothing
Set adoCommand = Nothing
Set adoConnection = Nothing
objExcel.Visible = True
msgbox("ДАННЫЕ ЭКСПОРТИРОВАНЫ!!!")

Добавлено:
Все скрипт написал. Кому Нужно Смотрите.
Скрип Читает данные из Excel и меняет Атрибуты у пользователей в AD.

Option Explicit
Dim objRootLDAP, objContainer, objUser, objShell
Dim objExcel, objSpread, intRow
Dim strUser, strOU, strSheet
Dim strCN, strdepartment, strmobile, strcompany, stripPhone, strtitle


' -------------------------------------------------------------'
' Important change OU= and strSheet to reflect your domain
' -------------------------------------------------------------'

strOU = "OU=vbstest ," ' Note the comma
strSheet = "c:\userlist.xls"

' Bind to Active Directory, Users container.
Set objRootLDAP = GetObject("LDAP://rootDSE")
Set objContainer = GetObject("LDAP://" & strOU & _
objRootLDAP.Get("defaultNamingContext"))

' Open the Excel spreadsheet
Set objExcel = CreateObject("Excel.Application")
Set objSpread = objExcel.Workbooks.Open(strSheet)
intRow = 3 'Row 1 often contains headings

' Here is the 'DO...Loop' that cycles through the cells
' Note intRow, x must correspond to the column in strSheet
Do Until objExcel.Cells(intRow,1).Value = ""
strdepartment = Trim(objExcel.Cells(intRow, 6).Value)
strtitle = Trim(objExcel.Cells(intRow, 5).Value)
stripPhone = Trim(objExcel.Cells(intRow, 4).Value)
strcompany = Trim(objExcel.Cells(intRow, 3).Value)
strmobile = Trim(objExcel.Cells(intRow, 2).Value)
strCN = Trim(objExcel.Cells(intRow, 1).Value)


' Build the actual User from data in strSheet.
Set objUser = GetObject _
("LDAP://cn=" & strCN & ",OU=vbstest,dc=xxx,dc=xxxxx")

objUser.department = strdepartment
objUser.title = strtitle
objUser.ipPhone = stripPhone
objUser.company = strcompany
objUser.mobile = strmobile

objUser.SetInfo



intRow = intRow + 1
Loop
objExcel.Quit

WScript.Quit

' End of free example UserSpreadsheet VBScript.

В Excele файле подгоняем голонки по номерам забиваем инфу и юзаем скрипт.
Источник: 
http://forum.ru-board.com/topic.cgi?forum=33&topic=1491&start=1780

1 комментарий:

  1. Советую воспользоваться очень удобной и легкой в использовании программой "Выгрузка объектов из Active Directory" (http://sysadminsoft.ru/export-from-ad). Это, пожалуй, лучшее программное решение в своем классе.

    ОтветитьУдалить