*ARCHIVE* Various Windows scripts.
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 

84 lines
5.1 KiB

' Создан: Пт 30 авг 2013 10:25:12
' Изменён: Сб 14 сен 2013 12:43:04
' (c) 2013, Maxim Lihachev, <envrm@yandex.ru>
'
' Вывод адресной книги из файла xlsm в консоли.
' Вывод записей с ненастроенным коротким набором на мобильные номера.
'
' Проверка аргументов
If WScript.Arguments.Count < 1 Then
Wscript.Echo "Использование: " & WScript.ScriptName & " addressbook.xlsm [check]"
WScript.Quit
Else
' Открытие файла адресной книги в режиме Read only
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open (Wscript.Arguments.Item(0), False, True)
End If
' Включение проверки отсутсвующей переадресации
If WScript.Arguments.Count = 2 Then
If WScript.Arguments.Item(1) = "check" Then
check = True
Else
check = False
End If
End If
' Начинать просматривать файл с 18 строки
currentRow = 18
' Цвет пометки о необходимости короткого набора
colorMark = 6
Set objCmdLib = CreateObject("Microsoft.CmdLib")
Set objCmdLib.ScriptingHost = WScript.Application
' Форматированный вывод
Dim arrResultsArray()
' Начальная строка
tableRow = 0
' Формат вывода данных
arrHeader = Array("Position", "Name", "Phone", "Short", "Mail", "Work phone", "Private mobile", "Work mobile")
arrMaxLength = Array(26, 35, 5, 5, 15, 15, 15, 15)
strFormat = "Table"
blnPrintHeader = True
arrBlnHide = Array(False, False, False, False, False, False, False, False, False, False)
strComputer = "."
' Просмотр файла
Do
' Строка из адресной книги
info = Array(objExcel.Cells(currentRow, 2).Value, _
objExcel.Cells(currentRow, 3).Value, _
objExcel.Cells(currentRow, 4).Value, _
objExcel.Cells(currentRow, 5).Value, _
objExcel.Cells(currentRow, 6).Value, _
objExcel.Cells(currentRow, 7).Value, _
objExcel.Cells(currentRow, 8).Value, _
objExcel.Cells(currentRow, 9).Value)
' Добавление элемента в массив
ReDim Preserve arrResultsArray(tableRow)
' Проверка на наличие цветовой метки
If objExcel.Cells(currentRow, 1).Interior.ColorIndex = colorMark Then
arrResultsArray(tableRow) = info
tableRow = tableRow + 1
ElseIf check = False Then
arrResultsArray(tableRow) = info
tableRow = tableRow + 1
End If
currentRow = currentRow + 1
Loop While Not objExcel.Cells(currentRow,1).Value = "" Or Not objExcel.Cells(currentRow,2).Value = ""
' Вывод таблицы данных
objCmdLib.ShowResults arrHeader, arrResultsArray, arrMaxLength, strFormat, blnPrintHeader, arrBlnHide
' Установка флага о сохранении, чтобы Excel не показывал запрос
objWorkbook.Saved = True
objExcel.Quit