Заполнение справочника пользователей
Здравствуйте форумчане надоело ожидать когда отдел кадров заполнит справочник по юзерам с их телефонами и стандартными данными задался целью написать чтонибудь простенькое т.к. опыта в этом деле у меня огромный НОль то написал чтото но не работает подскажите где ошибка.
Код:
On Error Resume Next
Dim strResult
Dim Input, BtnCode
Dim FSO,FileName,F,s,TextStream 'Объявляем переменные
Const ForReading = 1, ForWriting = 2, TristateUseDefault = -2
'Создаем объект FileSystemObject
Set FSO = WScript.CreateObject("Scripting.FileSystemObject")
a=Weekday(now)
if a <> 2 then
FSO.DeleteFile "c:\1.txt"
WScript.Quit
end if
b=day(now)
if b >=8 then
WScript.Quit
end if
' Открываем файл для чтения
set F=FSO.GetFile("c:\1.txt")
Set TextStream = F.OpenAsTextStream(ForReading, TristateUseDefault)
s=TextStream.ReadLine
TextStream.Close
'WScript.Echo s
if s=1 then
WScript.Quit
end if
'сообщение
MsgBox "Добрый день, для заполнения справочных данных в адресной книге OUTLOOK" & VbCrLf &"рекомендуем проверить и заполнить ваши данные"& VbCrLf &"Будьте пожалуйста внимательны при заполнение своих данных т.к. они доступны для всех сотрудников ДУ" , vbInformation ,"ВНИМАНИЕ"
StrDomain = "MYDOMEN"
Set WSHNetwork = CreateObject("WScript.Network")
Set WSHShell = CreateObject("WScript.Shell")
If WSHNetwork.UserDomain = StrDomain Then
Path = WSHNetwork.UserName
Set objSysInfo = CreateObject("ADSystemInfo")
strUserDN = objSysInfo.UserName
Set objUser = GetObject("LDAP://" & strUserDN)
strResult = ""
strResult = strResult & "Ф.И.О.: "& _
objUser.DisplayName & VbCrLf
strResult = strResult & "Телефон: "& _
objUser.TelephoneNumber & VbCrLf
strResult = strResult & "Должность: "& _
objUser.Title & VbCrLf
strResult = strResult & "Отдел: "& _
objUser.Department & VbCrLf
strResult = strResult & "Подразделение: "& _
objUser.Company & VbCrLf
BtnCode = WshShell.Popup (strResult ,, "ВЕРНЫ ЛИ ВАШИ ДАННЫЕ ?",4+32)
'сбор сведений о телефоне
While objUser.TelephoneNumber = ""
WScript.Echo "Нет данных о вашем телефоне"
Input = InputBox("Введите правильный номер вашего телефона,включая внутренний :"&VbCrLf&VbCrLf&"НАПРИМЕР: (343)3490005 вн.161","Телефон")
objUser.Put "TelephoneNumber" , Input
objUser.SetInfo
Wend
'сбор сведений о должности
While objUser.Title = ""
WScript.Echo "Нет данных о вашей должности"
Input = InputBox("Введите вашу должность","Должность")
objUser.Put "Title" , Input
objUser.SetInfo
Wend
'сбор сведений о отделе
While objUser.Department = ""
WScript.Echo "Нет данных о вашем отделе"
Input = InputBox("Введите название вашего отдела","Отдел",objUser.Department)
objUser.Put "Department" , Input
objUser.SetInfo
Wend
'сбор сведнеий о подразделении
if objUser.Company = "" Then
WScript.Echo "Нет данных о вашем подразделении"
Input = InputBox("Введите название вашего подразделения","Отдел",objUser.Company)
objUser.Put "Company" , Input
objUser.SetInfo
end if
Select Case BtnCode
case 6 MsgBox "Спасибо.До свидания",vbInformation,"Пока Пока"
' Описание: Создание временного файла
'Создаем файл
FileName = day(now)
Set F = FSO.CreateTextFile("c:\1.txt", true)
F.WriteLine 1
F.Close
WScript.Quit
case 7 MsgBox "Введите корректные данные :",vbQuestion,"Данные"
End Select
ChangeNumber()
Sub ChangeNumber
Input = InputBox("Введите правильный номер вашего телефона,включая внутренний :"&VbCrLf&VbCrLf&"НАПРИМЕР: (343)3490005 вн.161","Телефон",objUser.TelephoneNumber)
objUser.Put "TelephoneNumber" , Input
objUser.SetInfo
'WScript.Echo "Новый номер вашего телефона: " & objUser.TelephoneNumber
End Sub
ChangeTitle()
Sub ChangeTitle
Input = InputBox ("Введите Вашу Должность :","Должность",objUser.Title)
objUser.Put "Title" , Input
objUser.SetInfo
'WScript.Echo "Должность: " & objUser.Title
End Sub
ChangeDepartment()
Sub ChangeDepartment
Input = InputBox ("Введите Ваш Отдел :","Отдел",objUser.Department)
objUser.Put "Department" , Input
objUser.SetInfo
'WScript.Echo "Ваш Отдел: " & objUser.Department
End Sub
ChangeCompany()
Sub ChangeCompany
Input = InputBox ("Введите Ваше Подразделение :","Подразделение",objUser.Company)
objUser.Put "Company" , Input
objUser.SetInfo
'WScript.Echo "Ваш Отдел: " & objUser.Company
End Sub
MsgBox "Спасибо,до свидания",vbInformation,"До свидания"
' Описание: Создание временного файла
'Создаем объект FileSystemObject
Set FSO = WScript.CreateObject("Scripting.FileSystemObject")
'Создаем файл
FileName = day(now)
Set F = FSO.CreateTextFile("c:\1.txt", true)
F.WriteLine 1
F.Close
WScript.Quit
Else
WScript.Quit
End If
|
