Перейти из форума на сайт.

НовостиФайловые архивы
ПоискАктивные темыТоп лист
ПравилаКто в on-line?
Вход Забыли пароль? Первый раз на этом сайте? Регистрация
Компьютерный форум Ru.Board » Компьютеры » Прикладное программирование » Программирование "удобняшек" на VBScript

Модерирует : ShIvADeSt

ShIvADeSt (12-07-2011 15:12): http://forum.ru-board.com/topic.cgi?forum=33&topic=11963#1  Версия для печати • ПодписатьсяДобавить в закладки
Страницы: 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112

   

skimitar

Newbie
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Как ни странно возникли.

Всего записей: 24 | Зарегистр. 29-11-2005 | Отправлено: 20:16 23-09-2010
ComradG



Silver Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
skimitar
Дык ты б сказал в чем именно, чай не телепат.

Всего записей: 2038 | Зарегистр. 05-07-2008 | Отправлено: 20:17 23-09-2010
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 файле.

Всего записей: 24 | Зарегистр. 29-11-2005 | Отправлено: 06:52 24-09-2010
Free_Soft



Advanced Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Подскажите, как можно запустить батник vbs скриптом, чтобы консольное окно не появлялось?

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

так почему-то запускается через раз.запускаю через wscript.exe. Через сscript.exe срабатывает всегда, но мигает консольное окно

Всего записей: 1536 | Зарегистр. 19-04-2010 | Отправлено: 11:32 24-09-2010 | Исправлено: Free_Soft, 11:32 24-09-2010
ComradG



Silver Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Free_Soft

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

Только консольное окно все равно вылезит, если ты vbs-ку будешь запускать по двойному клику по нему, а не из самой консоли. Для того, чтобы запустить еще и саму vbs скрытой, нужно ее запускать в системе через inf сценарий.
 
skimitar
Цитата:
так как я не знаю синтаксис VBScript

Оно и видно по скрипту то.
 
smail04
Код:
Dim WSHShell, fso
Set WSHShell = WScript.CreateObject("WScript.Shell")
Set fso = WScript.CreateObject("Scripting.FileSystemObject")
 
Function MakeDesktopShortcut(name, target)
Dim Shortcut, DesktopPath, StartupPath
DesktopPath = WSHShell.SpecialFolders("Desktop")
Set Shortcut = WSHShell.CreateShortcut(DesktopPath & "\" & name & ".lnk")
Shortcut.TargetPath = target
StartupPath = fso.GetParentFolderName(target)
 
If fs.FolderExists(StartupPath) then
  Shortcut.WorkingDirectory = StartupPath
End If
Shortcut.Save
End Function
 
MakeDesktopShortcut "Моя программище", "C:\Program Files\MyProgram\MyApp.exe"


Всего записей: 2038 | Зарегистр. 05-07-2008 | Отправлено: 11:51 24-09-2010 | Исправлено: ComradG, 12:08 24-09-2010
Free_Soft



Advanced Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
ComradG
Спасибо, кажется получилось
 
Добавлено:

Цитата:
%comspec%

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

Всего записей: 1536 | Зарегистр. 19-04-2010 | Отправлено: 12:11 24-09-2010
ComradG



Silver Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Free_Soft
Ты разве не смотрел на "голый" вывод команды set в консоли? %comspec% = cmd.exe В vbs'ках %comspec% использовать предпочтительней.

Всего записей: 2038 | Зарегистр. 05-07-2008 | Отправлено: 12:28 24-09-2010
skimitar

Newbie
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Вроде скрипт выше мною на писаный работает но есть проблема.
Ввод данных Атрибутов для пользователя обратно в 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

Всего записей: 24 | Зарегистр. 29-11-2005 | Отправлено: 13:57 24-09-2010
skimitar

Newbie
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
У кого нибудь есть мысли по данному вопросу ?

Всего записей: 24 | Зарегистр. 29-11-2005 | Отправлено: 08:06 27-09-2010
ComradG



Silver Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору

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

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

Всего записей: 2038 | Зарегистр. 05-07-2008 | Отправлено: 11:51 27-09-2010
skimitar

Newbie
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору

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

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

Всего записей: 24 | Зарегистр. 29-11-2005 | Отправлено: 14:46 27-09-2010
skimitar

Newbie
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Всем спасибо за помощь проблему решил другим способом через 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.

Всего записей: 24 | Зарегистр. 29-11-2005 | Отправлено: 09:06 28-09-2010
Koolyan



Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
не подскажите  такой  вопросик , есть куча вордовских  документов, есть ли скриптик  поиска по словам не открывая  их, просто каждый док примерно по  4-7mb

Всего записей: 264 | Зарегистр. 04-08-2006 | Отправлено: 12:26 30-09-2010
ComradG



Silver Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
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
в своеv скрипте.

Всего записей: 2038 | Зарегистр. 05-07-2008 | Отправлено: 14:47 30-09-2010
Koolyan



Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
ComradG
спасибо попробую

Всего записей: 264 | Зарегистр. 04-08-2006 | Отправлено: 19:56 30-09-2010
ComradG



Silver Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
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
Как-то так...

Всего записей: 2038 | Зарегистр. 05-07-2008 | Отправлено: 22:26 30-09-2010
Free_Soft



Advanced Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Есть код, создающий точку восстановления системы:

Код:
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

Подскажите, как прикрутить заголовок окна сюда и добавить иконки к сообщениям: успех=info, ошибка=critical
Заранее Спасибо

Всего записей: 1536 | Зарегистр. 19-04-2010 | Отправлено: 22:27 30-09-2010
ComradG



Silver Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Free_Soft
Заголовок сообщения, надо думать? Насколько помню, то делаеся это приблизительно так:

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

На счет иконок точно не помню, кажись они в виде числового индекса там как-то указываются.

Всего записей: 2038 | Зарегистр. 05-07-2008 | Отправлено: 22:34 30-09-2010 | Исправлено: ComradG, 22:35 30-09-2010
Free_Soft



Advanced Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
ComradG
разобрался, спасибо

Всего записей: 1536 | Зарегистр. 19-04-2010 | Отправлено: 22:47 30-09-2010
bomzzz



Platinum Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
точно - если у тебя вбс скрипт то проще месадж бокс вывести в самом скрипте
 
Добавлено:
числовые индексы такие же как в таблице к месаджбоксу приложеной

Всего записей: 13343 | Зарегистр. 13-01-2008 | Отправлено: 22:49 30-09-2010
   

Страницы: 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112

Компьютерный форум Ru.Board » Компьютеры » Прикладное программирование » Программирование "удобняшек" на VBScript
ShIvADeSt (12-07-2011 15:12): http://forum.ru-board.com/topic.cgi?forum=33&topic=11963#1


Реклама на форуме Ru.Board.

Powered by Ikonboard "v2.1.7b" © 2000 Ikonboard.com
Modified by Ru.B0ard
© Ru.B0ard 2000-2024

BitCoin: 1NGG1chHtUvrtEqjeerQCKDMUi6S6CG4iC

Рейтинг.ru