Код:

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