» Программирование "удобняшек" на VBScript

BumerangII
Правильно, я runas уж лет пять как не использую, а потому и не помню какие там у него ключи.

Всем привет.
Нужен скрипт.
Который Будет Вытаскивать ИЗ Нужного OU Всех Пользователей с Атрибутами (Телефонный Номер, Офис должность Адресс ИТД) в Excel файл.
Потом Я вручную буду модифицировать атрибуты в Excel файле и обратно Загнать Все в AD.
C первым этапом я разобрался Из AD вытаскиваю в Excel юзеров нормально.
Информацию для юзеров модифицирую (name,mail,telephoneNumber,otherTelephone,displayName,title,department,mail,telephoneNumber,otherTelephone,mobile,homePhone")
А написать скрип для обратного загона инфы в AD не получается. Помогите пожалуйста.

skimitar
Вот тебе простой пример того, как можно вносить изменения в текстовый файл.

Код: Set fso = CreateObject("Scripting.FileSystemObject")
Set file = fso.CreateTextFile(WScript.Arguments(1), True)
Path = fso.GetAbsolutePathName(WScript.Arguments(1))
GetName = fso.GetFileName(Path)
file.WriteLine(WScript.Arguments(0))
file.Close
If fso.FileExists(Path) Then
WScript.Echo "Создан файл с именем " & GetName
End If

Проблем нету с импортом из AD в Excel, Скрипт я написал работает он нормально, Но не получается сделать скрипт Который Будет Работать обратно Импортируя Измененные данные из Excel в AD

skimitar
Дык в чем дело: парсишь данные Excel'я и перезаписываешь в AD, - тут все по приниципу на 180 градусов. А уж если ты смог
Цитата:

из AD в Excel, Скрипт я написал работает он нормально

, то и трудностей возникнуть не должно сделать скрипт-"перевертыш".

Как ни странно возникли.

skimitar
Дык ты б сказал в чем именно, чай не телепат.

Проблемы в том что Скрипт на Экспорт данных из 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 файле.

Подскажите, как можно запустить батник vbs скриптом, чтобы консольное окно не появлялось?

Код: CreateObject("WScript.Shell").Run """%windir%\launch.cmd""", 0, False

Free_Soft

Код: Set WSHShell = CreateObject("WScript.Shell")
WSHShell.Run "%comspec% /c %systemroot%\launch.cmd", 0, False

ComradG
Спасибо, кажется получилось

Добавлено:

Цитата:

%comspec%

а какую функцию эта переменная здесь выполняет?

Free_Soft
Ты разве не смотрел на "голый" вывод команды set в консоли? %comspec% = cmd.exe В vbs'ках %comspec% использовать предпочтительней.

Вроде скрипт выше мною на писаный работает но есть проблема.
Ввод данных Атрибутов для пользователя обратно в AD возможно сделать только по такой системе ("LDAP://cn=" & strCN & ",OU=vbstest,dc=xxx,dc=xxxxx")
Тоесть я могу поменять данные только в конечном OU.
А хотелось бы чтобы данные Вбивались обратно в AD для всех & strCN & не зависимо от того в каком OU они находятся. Так как не очень интересно Для каждого(дых) & strCN & заново прописывать OU пути в Скрипте, их более 50-ти в Домене. Прошу вашей помощи.

Вот обновленный скрипт для Экспорта данных из Excel в AD
*****************************************************
Option Explicit
Dim objRootLDAP, objContainer, objUser, objShell
Dim objExcel, objSpread, intRow
Dim strUser, strOU, strSheet
Dim strCN, strdepartment, strTitle, strPhone, strOtherPhone, strMobile, strName, strcompany

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

Set objRootLDAP = GetObject("LDAP://rootDSE")
Set objContainer = GetObject("LDAP://" & strOU & _
objRootLDAP.Get("defaultNamingContext"))
Set objExcel = CreateObject("Excel.Application")
Set objSpread = objExcel.Workbooks.Open(strSheet)
intRow = 2 'Row 1 often contains headings
Do Until objExcel.Cells(intRow,1).Value = ""

strCN = Trim(objExcel.Cells(intRow, 1).Value)
strTitle = Trim(objExcel.Cells(intRow, 2).Value)
strdepartment = Trim(objExcel.Cells(intRow, 3).Value)
strPhone = Trim(objExcel.Cells(intRow, 4).Value)
strOtherPhone = Trim(objExcel.Cells(intRow, 5).Value)
strMobile = Trim(objExcel.Cells(intRow, 6).Value)
strcompany = Trim(objExcel.Cells(intRow, 7).Value)
strName = Trim(objExcel.Cells(intRow, 8).Value)




' Build the actual User from data in strSheet.
Set objUser = GetObject _
("LDAP://cn=" & strCN & ",OU=vbstest,dc=domain,dc=local")
objUser.displayName = strName
objUser.title = strTitle
objUser.department = strdepartment
objUser.telephoneNumber = strPhone
objUser.otherTelephone = strOtherPhone
objUser.mobile = strMobile
objUser.company = strcompany
objUser.SetInfo

intRow = intRow + 1
Loop
objExcel.Quit
WScript.Quit

У кого нибудь есть мысли по данному вопросу ?

Цитата:

У кого нибудь есть мысли по данному вопросу?

По какому именно? Ты ж сам вроде разобрался! Или тебе нужна оценка правильности твоего скрипта?

Цитата:

По какому именно? Ты ж сам вроде разобрался! Или тебе нужна оценка правильности твоего скрипта?

Вроде скрипт выше мною на писаный работает но есть проблема.
Ввод данных Атрибутов для пользователя обратно в AD возможно сделать только по такой системе ("LDAP://cn=" & strCN & ",OU=vbstest,dc=xxx,dc=xxxxx")
Тоесть я могу поменять данные только в конечном OU.
А хотелось бы чтобы данные Вбивались обратно в AD для всех & strCN & не зависимо от того в каком OU они находятся. Так как не очень интересно Для каждого(дых) & strCN & заново прописывать OU пути в Скрипте, их более 50-ти в Домене. Прошу вашей помощи.

Всем спасибо за помощь проблему решил другим способом через Excel и ActiveRoles Managment Shell for AD. (расширенный PowerShell)
Вот код решения:
="Set-QADUser "&C2&" -City '"&E2&" ' -StreetAddress '"&D2&"' -Title ' "&F2&" ' -Department '"&G2& "' -PhoneNumber '"&H2&"+"&I2&"' -MobilePhone '"&K2&"' -Fax '"&J2&"' -notes 'Сотовый. 2) "&L2&"' -HomePhone '"&M2&"'"

Если кому то прижмет то могу выслать Excel файл готовый для работы.

В переменных данные пользователя.
Все делается также быстро как и через Vbs.

не подскажите такой вопросик , есть куча вордовских документов, есть ли скриптик поиска по словам не открывая их, просто каждый док примерно по 4-7mb

Koolyan
Используй что-то вроде:
Код: Const ForReading = 1

Set fso = CreateObject("Scripting.FileSystemObject")
Set rtf = fso.OpenTextFile("C:\*.rtf")

For Each file in rtf
strContents = rtf.ReadAll
<условия поиска слова>
rtf.Close
Next

ComradG
спасибо попробую

Koolyan
Вот, тебе пример реализации поиска слов в вордоских документах.

Код: 'Вызываем Word собственной персоной
Set objWord = CreateObject("Word.Application")
objWord.Visible = False 'Скрываем Word с глаз долой

'Далее указываем путь до Wordовских доков
Set objDoc = objWord.Documents.Open("%userprofile%\Мои документы\*.doc")

'Теперь отдаем распоряжение загрузить
'искомое слово в память и искать его
'до тех пор, пока не будет достигнут
'конец документа
Set objSelection = objWord.Selection
objSelection.Find.Text = "Искомое слово"
objSelection.Find.Forward = True
objSelection.Find.MatchWholeWord = True

'Если слово обнаружено, то производим
'необходимое действие, в данном случае
'выводим на экран консоли сообщение
If objSelection.Find.Execute Then
WScript.Echo "Я нашел искомые строки в доках, сэр. А дальше чаво?"
Else
WScript.Echo "Не бейте меня, но я ни [thf не нашел, сэр."
End If

Есть код, создающий точку восстановления системы:

Код: Set sr = getobject("winmgmts:\\.\root\default:Systemrestore")

msg = "Точка восстановления удачно создана." & vbCR
msg = msg & "" & vbCR
msg = msg & "Название точки: MyPoint " & vbCR
msg = msg & "Дата и время создания: " & Date & " " & Time

If (sr.createrestorepoint("MyPoint", 0, 100)) = 0 Then
MsgBox msg
Else
MsgBox "Создание точки закончилось с ошибкой!"
End If

Free_Soft
Заголовок сообщения, надо думать? Насколько помню, то делаеся это приблизительно так:

Код: strMsg = "Это, собственно, текст самого сообщения," & Chr(10) & "которое должен будет увидеть пользователь"
MsgBox strMsg, 0, "А то заголовок окна"

ComradG
разобрался, спасибо

точно - если у тебя вбс скрипт то проще месадж бокс вывести в самом скрипте

Добавлено:
числовые индексы такие же как в таблице к месаджбоксу приложеной

Цитата:

числовые индексы такие же как в таблице к месаджбоксу приложеной

Напомни, пожалуйста, если не сложно.

Цитата:

Например 4096+256+32+3=4387

Да не, примеры то мне как раз не нужны, просто освежить в памяти хотелось кое чего. Но все равно спасибо.

ну это к тому, что складывать надо

Добавлено:
http://msdn.microsoft.com/en-us/library/ms645505%28VS.85%29.aspx

Добавлено:
1048576 - арабское окно еще для слева направо

Цитата:

ну это к тому, что складывать надо

Дык это ясно из контекста и потом на http://msdn.microsoft.com/en-us/library/ms645505(VS.85).aspx вообще много чего полезного, только про него вспоминают в последнюю очередь.