skimitar
Newbie | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору Проблемы в том что Скрипт на Экспорт данных из AD в Excel я взял готовый немного изменив, а так как я не знаю синтаксис VBScript то Не получается сделать обратный процесс. Вот Сам скрипт на вынос данных. Option Explicit Dim objRootDSE, strDNSDomain, strBase Dim adoCommand, adoConnection, objRS, strFilter, strAttributes, strQuery Dim objExcel, strName, strPhone, strMail, strOtherphone, arrOtherPhone, strItem Dim 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 = "<LDAP://" & strDNSDomain & ">" 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 файле подгоняем голонки по номерам забиваем инфу и юзаем скрипт. Все очень удобно особенно если большая компания и данные постоянно меняются, в AD лезть лень и муторно а тут достаточно менять инфу только в Excele файле. |