Тема: VBScript: Счетчик печати
Мне нужно скриптом, на локальном компьютере, определить сколько страниц будет распечатанно при печати на принтере ...
Без использования сторонних программ и т.д.
Язык провольный , но желательно VBScript ...
Вы не вошли. Пожалуйста, войдите или зарегистрируйтесь.
Страницы 1
Чтобы отправить ответ, вы должны войти или зарегистрироваться
Мне нужно скриптом, на локальном компьютере, определить сколько страниц будет распечатанно при печати на принтере ...
Без использования сторонних программ и т.д.
Язык провольный , но желательно VBScript ...
Если именно «сколько будет» — то, по-моему — никак. Я видел скрипт, где отслеживалось, сколько «было» послано на печать (через событие __InstanceCreationEvent для класса Win32_PrintJob). Естественно, если драйвер считает страницы иначе, нежели оригинальное приложение — результат будет неверным (я с подобным сталкивался):
Option Explicit
Dim objSWbemServicesEx
Dim objFilter
Dim objConsumer
Dim objBinding
Set objSWbemServicesEx = GetObject("winmgmts:\\.\Root\CIMv2")
Set objFilter = objSWbemServicesEx.Get("__EventFilter").SpawnInstance_()
With objFilter
.Name = "Monitoring PrintJob"
.QueryLanguage = "WQL"
.Query = "SELECT * FROM __InstanceCreationEvent WITHIN 5 " & _
"WHERE TargetInstance ISA 'Win32_PrintJob'"
.Put_
End With
Set objConsumer = objSWbemServicesEx.Get("LogFileEventConsumer").SpawnInstance_()
With objConsumer
.Name = "Monitoring PrintJob Log"
.FileName = "C:\MonitoringPrintJob.txt"
.Text = "Name: %TargetInstance.Name%, Document: %TargetInstance.Document%, Owner: %TargetInstance.Owner%, TotalPages: %TargetInstance.TotalPages%, StartTime: : %TargetInstance.StartTime%, PagesPrinted: : %TargetInstance.PagesPrinted%"
.Put_
End With
Set objFilter = objSWbemServicesEx.Get("__EventFilter.Name='Monitoring PrintJob'")
Set objConsumer = objSWbemServicesEx.Get("LogFileEventConsumer.Name='Monitoring PrintJob Log'")
Set objBinding = objSWbemServicesEx.Get("__FilterToConsumerBinding").SpawnInstance_()
With objBinding
.Filter = objFilter.Path_
.Consumer = objConsumer.Path_
.Put_
End With
Set objSWbemServicesEx = Nothing
WScript.Quit 0
Это, скорее, пример, нежели готовый скрипт. После отправки чего-либо на печать, смотрите «C:\MonitoringPrintJob.txt».
Замечание: после применения скрипта будьте готовы к «ручной» уборке с помощью WMI CIM Studio.
Спасибо.
Ясно.
Это, скорее, пример, нежели готовый скрипт. После отправки чего-либо на печать, смотрите «C:\MonitoringPrintJob.txt».
Вариант на AutoHotkey
http://www.autohotkey.com/forum/topic36140.html
The gray Cardinal, :
http://www.script-coding.com/WMI.html
Ещё одно важное замечание: по умолчанию не все стандартные классы устанавливаются в репозиторий CIM. Для использования стандартных классов постоянных потребителей (например, LogFileEventConsumer), скорее всего, придётся сначала установить их. MOF-файлы с описанием этих классов находятся в каталоге %SystemRoot%\system32\Wbem\. Скомпилировать эти файлы можно с помощью утилиты mofcomp.exe. Пример команды компиляции:
mofcomp -N:root\cimv2 %SystemRoot%\system32\Wbem\Wbemcons.mof
Без использования «-N:root\cimv2» он будет скомпилирован в стандартное для него пространство «root\subscription», соответственно, код скрипта изменится.
alexii
Ага, понятно .
Довольно сложный путь. Я делал проще - через WMI но и задача была чуть другая, статистика всех машин и всех принтеров предприятия. И всех распечатаных задач ессно. Данные писал в SQL.
RootAdmin, [голосом Якубовича] код — в студию.
Яволь. Работает уже с полгода, нареканий особых нет. Для ~400 машин опрос занимает часа 2-3 (каналы очень медленные), и много времени тратится на попытки установить соединение с недоступной машинкой. При каждом обращении забирает только еще не полученные данные, трафик экономит.
' aradionov@sbroiler.ru
' Серверный скрипт - сбор статистики по принтерам
' Version 1.1c
' +В этой версии поддерживаются транзакции и прибиты лишние сообщения в лог.
'Структура
'Таблица MashineName:
' Индекс для связи с LogTask
' Name (Varchar:XX)
' LastMessageTime(DataTime)
' ErrCode(int)
'
'Таблица LogTask
' MashineName (VarChar:XX)
' TimeTask (datatime)
' PrnName(VarChar:XX)
' UserName
' NameTask
' SumPages
'
'
Const ADS_SCOPE_SUBTREE = 5
'Под файловую систему
Set FSO = CreateObject("Scripting.FileSystemObject")
'Под AD
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
'Для SQLя
Dim cn
Dim rst
Set cn=CreateObject("ADODB.Connection")
Set rst=CreateObject("ADODB.Recordset")
'cn.open "uid=DOMAIN\admin;pwd=**********; driver={SQL Server}; server=DBSERVER2\MNG; database=SpoolLog"
cn.open "driver={SQL Server}; server=DBSERVER2\MNG; trusted_connection=yes; database=SpoolLog"
'Проверим статус соединения.
If cn.State=1 Then
'Msgbox "Connected"
else
Msgbox "Ошибка, не подключен SQL"
End If
'************* Зона отладки
' wscript.echo Cstr(FSO.GetParentFolderName(www))
' wscript.echo Cstr(GlobDateStart)
' wscript.echo Cstr(FormatDateTime(Now()-30,2))
LogToFile("Ghbdtn!")
'wscript.echo(DateSerial(2008,01,01))
'Wscript.Echo ("INSERT INTO LogTask (MashineName, TimeTask, PrnName,UserName,NameTask,SumPages) VALUES ( '" & ADS_SCOPE_SUBTREE &" ' ,'" & WM &" ' , '" & 888 &" ' ,'" & Cstr(strowner) &" ' ,'" & Cstr(StrDokName) &" ' , ' " & Cint(intpages) & " ' )")
'**************
'Откроем чтение данных из AD
objCommand.Properties("Page Size") = 100
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
objCommand.CommandText = _
"SELECT Name FROM " _
& "'LDAP://dc=DOMAIN,dc=ru' WHERE " _
& "objectCategory='computer'"
Set objRecordSet = objCommand.Execute 'Все - в набор записей
objRecordSet.MoveFirst 'На первую запись
'Объект objRecordSet содержит теперь список машинок из домена.
'Можно идти прямо по нему и читать логи с машинок. Подключились - если подключиться не удалось - проверили есть ли машинка в таблице MashineName
' Если нету - создали, записали код ошибки.
' если нет ошибок подключения - прочитали лог. Открыли транзакцию в SQL - записали, и тут же, не выходя из транзакции
' нашли машинку в таблице MashineName. Если там ее нет - добавили. И записали в поле LastMessageTime дататайм последнего события.
'Для начала надо запустить обработку по запсьно списка из AD
'Выполняем пока не кончатся.
Do Until objRecordSet.EOF 'Выполняем пока не кончатся.
'wscript.echo("Значение "+objRecordSet.Fields("Name").Value)
'Проверяем - есть ли машинка в базе.
rst.open "SELECT Name,LastMessageTime FROM MashineName Where Name='"&objRecordSet.Fields("Name").Value&"'", cn
'Объект Rst надо проверить. Если записей БОЛЬШЕ одной - то косяк, задвоено. Если одна - нормально, если не одной - тоже, создадим.
If Rst.EOF then
'Создаем. При этом - пишем в таблицу дататайм последнего забранного - скажем шестнадцать дней ранее.
LogToFile("Машинка "&objRecordSet.Fields("Name").Value&" не найдена в базе, добавляю")
cn.Execute "INSERT INTO MashineName (Name,LastMessageTime, ErrCode) VALUES ( '" _
& objRecordSet.Fields("Name").Value &"',CONVERT(DATETIME,'"& FormatDateTime(Now()-32,0) & "',104),' " & 0 & " ' )"
End If
Rst.Close
rst.open "SELECT Name,LastMessageTime FROM MashineName Where Name='"&objRecordSet.Fields("Name").Value&"'", cn
'wscript.echo("Запись есть для: "+objRecordSet.Fields("Name").Value)
LTimeRec=Cdate(rst.fields(1))
Rst.Close
' LogToFile("Время последней записи для машинки "&objRecordSet.Fields("Name").Value&" равно "<imeRec)
'Теперь запись точно есть
'Можно отправляться в процедуру и заполнять таблицу задач используя в качестве параметров запроса
'в качестве даты начала - дату из запроса Sql а в качестве последней даты - Now
'If objRecordSet.Fields("Name").Value= "EXCH" or objRecordSet.Fields("Name").Value= "TERMINAL2" then
If DateDiff("h",LTimeRec,Now())>8 then
LogToFile("Последнее событие для : " &Cstr(objRecordSet.Fields("Name").Value)&" Было более "&Cstr( DateDiff("h",LTimeRec,Now()) )&" часов назад, записано: "<imeRec )
CheckSpoolLog()
Else
LogToFile("Для : " &Cstr(objRecordSet.Fields("Name").Value)&" Было обработано "&Cstr( DateDiff("h",LTimeRec,Now()) )&" часов назад, записано: "& LTimeRec)
End If
objRecordSet.MoveNext
Loop
'rst.open "SELECT Name,LastMessageTime FROM MashineName", cn
'Wscript.echo("Добили!!! : "+Cstr(WScript.ScriptFullName))
LogToFile("Скрипт работу закончил в "&Cstr(Now()) )
Sub CheckSpoolLog
'Wscript.echo("Зашел в процедуру ")
''
'Обработка ошибок - внутренняя
on error resume next
'Получим датувремя последнего сообщения, объект из контекста получать не будем - вдруг закрыт. Подключимся и запросим, обработку задваивания не делаем
rst.open "SELECT Name,CONVERT(nvarchar(20), LastMessageTime, 120) AS Expr1, Flag FROM MashineName Where Name='"&objRecordSet.Fields("Name").Value&"'", cn
' Подключаемся по WMI, отправляем запрос
Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & RTrim(rst.fields(0)) & "\root\cimv2")
Set objCollection = objWMI.ExecQuery("SELECT * FROM Win32_NTLogEvent WHERE Logfile='System' " & _
"AND EventType=3 AND SourceName='Print' AND EventCode=10 and TimeWritten >= '" _
& Cdate(rst.fields(1)) & "' and TimeWritten < '" & Now() & "'")
'Заодно присвоим последнее время переменной - для последующего сравнения
TempTime=rst.fields(1)
' LogToFile( "ВРЕМЯ из запроса присвоили переменной: " &Cstr(TempTime) )
'Объект получили, rst закрываем
rst.close
'Тэээк обработаем ошибку - и запишем
If Err.Number>0 then
LogToFile( "При получении из " &Cstr(objRecordSet.Fields("Name").Value)&" ошибка"&Cstr(Err.Number))
LogToFile("Данные для отладки: "&objRecordSet.Fields("Name").Value&" Описание ошибки: "& Cstr(Err.Description)&Cstr(strMSG))
Err.Clear
Else
lngNumEvents = objCollection.Count
If lngNumEvents > 0 Then
LogToFile( "Найдено событий штук: " & lngNumEvents &"Для машинки " &Cstr(objRecordSet.Fields("Name").Value) )
'**** Вот тут начать транзакцию. *****
cn.BeginTrans()
For Each objItem In objCollection
'Обработаем строку, которая и является искомым объектом.
strMsg = objItem.Message
'Нашли все нужные данные.
intPosL = InStr(1, strMsg, " владельца ", vbTextCompare)
If IntPosl=0 then intPosL = InStr(1, strMsg, " owned by ", vbTextCompare)
intPosR = InStr(1, strMsg, " напечатан", vbTextCompare)
If IntPosR=0 then intPosR = InStr(1, strMsg, " was printed", vbTextCompare)
StrDokName= left(strMsg,intPosl-1)
strOwner = Mid(strMsg, intPosL + 11, intPosR - intPosL - 10)
intPosL = InStrRev(strMsg, ":")
If IsNumeric(Mid(strMsg, intPosL + 2)) then
intPages = CInt(Mid(strMsg, intPosL + 2))
Else
IntPages = 1
End If
intPosL = 0
intPosR = 0
intPosL = InStrRev(strMsg, "напечатан на ")
If IntPosl=0 then intPosL = InStr(1, strMsg, "s printed on", vbTextCompare)
intPosR = InStr(intPosL,strMsg, " через порт ", vbTextCompare)
If IntPosR=0 then intPosR = InStr(IntPosl,strMsg, " via port ", vbTextCompare)
PrnName= Trim(Mid(strMsg, intPosL + 13, intPosR - intPosL - 12))
'Здесь сваяем ИНСЕРТ, который будетдобавлять все полученное тяжким запросом в скуль
'Таблица LogTask
' MashineName (VarChar:20)
' TimeTask (datatime)
' PrnName(VarChar:50)
' UserName(VarChar:16)
' NameTask(VarChar:200)
' SumPages
'
'Прверим ошибки, если что - в лог.
If Err.Number>0 then LogToFile( "Для машинки " &Cstr(objRecordSet.Fields("Name").Value)&" в цикле ошибка, строка " &Cstr(StrMsg)&" ошибка"&Cstr(Err.Number))&" "&IntPosl&" "&IntPosr
' Проверим, есть ли в StrDokName апострофы и заэкранируем
StrDokName=Replace(StrDokName, "'", "/'")
cn.Execute "INSERT INTO LogTask (MashineName,TimeTask,PrnName,UserName,NameTask,SumPages) VALUES" _
&"('" & objRecordSet.Fields("Name").Value &"',CONVERT(DATETIME,'"& FormatDateTime(WMIDateToString(objItem.TimeWritten) )&"',104),'" _
& Left(PrnName,50) &" ','" & Cstr(strowner) &"','" &Left(StrDokName,200)&"','" & Cint(intpages) & "')"
'А вто тут - отберем самое пследнее время события полученного. Методом пузырька.
'LogToFile( "Время объекта: " & WMIDateToString(objItem.TimeWritten) &" Время сравнения " &TempDate)
If DateDiff("s", TempDate,WMIDateToString(objItem.TimeWritten))>0 then
LogToFile( "Сравним время " & Cstr( DateDiff("s",TempDate,WMIDateToString(objItem.TimeWritten)) ) )
TempDate=WMIDateToString(objItem.TimeWritten)
LogToFile( "Теперь: " & Cstr( TempDate) )
End If
Next
'Обработаем ошибки. Если возникли - тупо не закрываем транзакцию
If Err.Number>0 then
LogToFile( "Для машинки по выходу из цикла ошибка " &Cstr(objRecordSet.Fields("Name").Value)&" ошибка"&Cstr(Err.Number))
LogToFile("Данные для отладки: "&objRecordSet.Fields("Name").Value&" Описание ошибки"& Cstr(Err.Description)&Cstr(strMSG))
'***** Вот тут отменить транзакцию
cn.RollbackTrans
cn.Execute "UPDATE MashineName SET ErrCode= ' " & Err.Number & " ' WHERE Name='" & objRecordSet.Fields("Name").Value & "'"
Err.Clear
Else
LogToFile( "Машинка " &Cstr(objRecordSet.Fields("Name").Value)&" успешно обработана, Время последнего: "&Cstr(TempTime))
' TestQuery("Вход в успешную обработку, запрос")
cn.Execute "UPDATE MashineName SET LastMessageTime= CONVERT(DATETIME,'"& _
FormatDateTime(TempDate) &"',104) WHERE Name='" & objRecordSet.Fields("Name").Value & "'"
'***** Вот тут закрыть транзакцию, обновив датутайм в таблице MashineName
cn.CommitTrans
' TestQuery("Выход успешной обработки, запрос")
End If
Else
LogToFile( "Для машинки " &Cstr(objRecordSet.Fields("Name").Value)&" событий нет")
End If
End If
'Обработка ошибок - OFF
On Error GoTo 0
End Sub
Function WMIDateToString(dtmDate)
'возвращает дататайм в нормальном виде, не в WMI
WMIDateToString = (Mid(dtmDate, 7, 2) & "-" & _
Mid(dtmDate, 5, 2) & "-" & _
Left(dtmDate, 4) & " " & _
Mid(dtmDate, 9, 2) & ":" & _
Mid(dtmDate, 11, 2) & ":" & _
Mid(dtmDate, 13, 2))
End Function
Function LogToFile(TextLog)
'Тупо пишет строку в файл лога, в основном для отладки
LogPath=FSO.GetParentFolderName(WScript.ScriptFullName)&"\"&WScript.ScriptName&".log"
Set TextStream = FSO.OpenTextFile(LogPath,8,True)
TextStream.WriteLine(Cstr(Now())&Chr(09)&TextLog)
TextStream.Close
End Function
Function TestQuery(Text)
rst.open "SELECT Name,LastMessageTime FROM MashineName Where Name='"&objRecordSet.Fields("Name").Value&"'", cn
Call LogToFile(Text&" "&rst.fields(0)&" равно "&" "&rst.fields(1))
Rst.Close
End function
Написано для MS SQL. В строке ниже указывается сервер и имя базы. Вариант работает с доменной авторизацией в базу, если авторизация внутренняя, раскомментировать
'cn.open "uid=DOMAIN\admin;pwd=**********; driver={SQL Server}; server=DBSERVER2\MNG; database=SpoolLog"
исправить и закомментировать следующую.
В строке
& "'LDAP://dc=DOMAIN,dc=ru' WHERE " _
правим домен под свой.
В общем все просто, под англоязычные рабочие станции разбор строки заточен.
Есть еще скриптик, который данные из SQL тащит в EXCEL
' aradionov@sbroiler.ru
' Пользовательский генератор отчета статистики принтеров.
' Version 0.90a
'Структура
'Таблица MashineName:
' Индекс для связи с LogTask
' Name (text:12)
' LastMessageTime(DataTime)
' ErrCode(int)
'
'Таблица LogTask
' MashineName (text:12)
' TimeTask (datatime)
' UserName
' NameTask
' SumPages
'
'
Set FSO = CreateObject("Scripting.FileSystemObject")
'Для Excel
'Для SQLя
Dim cn
Dim rst
Set cn=CreateObject("ADODB.Connection")
Set rst=CreateObject("ADODB.Recordset")
'cn.open "uid=DOMAIN\admin;pwd=; driver={SQL Server}; server=DBSERVER2\MNG; database=SpoolLog"
cn.open "driver={SQL Server}; server=DBSERVER2\MNG; trusted_connection=yes; database=SpoolLog"
'Проверим статус соединения.
If cn.State=1 Then
'Msgbox "Connected"
else
Msgbox "Ошибка, не подключен SQL"
End If
x = 1
'Тут прверим - есть ли файл Экселя, если есть - откроем, нет - создадим-заполним.
If FSO.FileExists(Left(WScript.ScriptFullName,len(WScript.ScriptFullName)-len(WScript.ScriptName))&"Отчет.xls") then
'Wscript.echo("Док уже есть!: "+Cstr(WScript.ScriptFullName))
'Надо его открыть!
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
Set objWorkbook = objExcel.Workbooks.Open(Left(WScript.ScriptFullName,len(WScript.ScriptFullName)-len(WScript.ScriptName))&"Отчет.xls")
'Получим из открытого дока последнюю строку с именем машинки.
x=x+1 'установим первую строку с именем машинки
Do Until objExcel.Cells(x, 1).Value =""
x=x+1
Loop
Last_Row=x
' Wscript.echo("Последняя строка: "+Cstr(x))
'И строку последнюю данных найдем:
x=ObjExcel.Cells(1,1).SpecialCells(11).Row +1
Else
'Файла с отчетом нет, создадим запрос и заполним.
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
ObjExcel.SheetsInNewWorkbook = 1
Set objWorkbook = objExcel.Workbooks.add
objWorkbook.Sheets(1).name = "Пользователи"
Set objRange = objExcel.Range("A1")
objRange.Activate
Set objRange = objExcel.ActiveCell.EntireColumn
objRange.Autofit()
objExcel.Cells(x, 1).Value = "Пользователь"
objExcel.Cells(x, 2).Value = "Заданий"
objExcel.Cells(x, 3).Value = "Страниц"
x=x+1
' Начнем с юзерей
rst.open "SELECT UserName, SUM(SumPages) AS Pages, COUNT(NameTask) AS Ncount FROM LogTask GROUP BY UserName order by username", cn
Do until rst.eof
Set Butt=objExcel.ActiveSheet.OLEObjects.Add("Forms.CommandButton.1")
Butt.Left = 160
Butt.Top = 12.75*(x-1)
Butt.Width = 126.75
Butt.Height = 12
'Butt.Font.Name = "Times New Roman"
Butt.Object.FontSize = 6
'Butt.Font.Bold = True
Butt.Name=Cstr(RSt.Fields(0).Value)&"_Butt"
Butt.Object.Caption = Cstr(RSt.Fields(0).Value)&" "&Cstr(RSt.Fields(2).Value)&" "&Cstr(RSt.Fields(1).Value)
Set xlmodule = objWorkbook.VBProject.VBComponents.Item(1)
' Add a macro to the module...
strCode = _
"Private Sub CommandButton"&x-1&"_Click()" & vbCr & _
"' msgbox ""Адрес Row и Column ""&CStr(ActiveCell.Row)&"" ""&CStr(ActiveCell.Column)" & vbCr & _
"Dim cn"&vbCr & _
"Dim rst"&vbCr & _
"Set cn=CreateObject(""ADODB.Connection"") "&vbCr & _
"Set rst=CreateObject(""ADODB.Recordset"")"&vbCr & _
"cn.open ""driver={SQL Server}; server=DBSERVER2\MNG; trusted_connection=yes; database=SpoolLog"" "&vbCr & _
"'Проверим статус соединения."&vbCr & _
"If cn.State=1 Then "&vbCr & _
"'Msgbox ""Connected"" "&vbCr & _
"else "&vbCr & _
"Msgbox ""Ошибка, не подключен SQL"" "&vbCr & _
"End If "&vbCr & _
"rst.open ""SELECT TimeTask,PrnName, NameTask, SumPages FROM LogTask Where UserName='"&Trim(RSt.Fields(0).Value)&"' order by TimeTask"", cn "&vbCr & _
"Sheets.Add.Name="""&Cstr(RSt.Fields(0).Value)&""""&vbCr & _
"x=1"&vbCr & _
" do until rst.eof"&vbCr & _
" ActiveCell.Offset(x, 0).FormulaR1C1 = Cstr(RSt.Fields(0).Value)"&vbCr & _
" ActiveCell.Offset(x, 1).FormulaR1C1 = Cstr(RSt.Fields(1).Value)"&vbCr & _
" ActiveCell.Offset(x, 2).FormulaR1C1 = Cstr(RSt.Fields(2).Value)"&vbCr & _
" ActiveCell.Offset(x, 3).FormulaR1C1 = Cstr(RSt.Fields(3).Value)"&vbCr & _
" x = x + 1 "&vbCr & _
" Rst.MoveNext "&vbCr & _
" Loop "&vbCr & _
"Rst.close"&vbCr & _
"ActiveCell.Offset(x, 3).FormulaR1C1 = ""=SUM(R[-""&CStr(x)&""]C:R[-1]C)"""&vbCr & _
"ActiveSheet.Columns(""A:D"").Select"&vbCr & _
"Selection.Columns.AutoFit"&vbCr & _
"end sub"
xlmodule.CodeModule.AddFromString strCode
objExcel.Cells(x, 1).Value = _
Cstr(RSt.Fields(0).Value)
objExcel.Cells(x, 2).Value = _
Cstr(RSt.Fields(2).Value)
objExcel.Cells(x, 3).Value = _
Cstr(RSt.Fields(1).Value)
x = x + 1
Rst.MoveNext
Loop
Rst.close
'Не прибиваем воркбук - он еще будет нужен. как объект
'Заодно выведем принтеры:
objWorkbook.Sheets.Add
objWorkbook.Sheets(1).name = "Принтеры"
x=1
objExcel.Cells(x, 1).Value = "Принтер"
objExcel.Cells(x, 2).Value = "Заданий"
objExcel.Cells(x, 3).Value = "Страниц"
x=x+1
rst.open "SELECT PrnName, COUNT(NameTask) AS Ncount, SUM(SumPages) AS Pages FROM LogTask GROUP BY PRNName Order by PrnName", cn
do until rst.eof
Set Butt=objExcel.ActiveSheet.OLEObjects.Add("Forms.CommandButton.1")
Butt.Left = 180
Butt.Top = 12.75*(x-1)
Butt.Width = 250
Butt.Height = 12.5
Butt.Object.FontSize = 6
Butt.Object.Caption = Cstr(RSt.Fields(0).Value)&" "&Cstr(RSt.Fields(1).Value)&" "&Cstr(RSt.Fields(2).Value)
Set xlmodule = objWorkbook.VBProject.VBComponents.Item("Лист2")
' Add a macro to the module...
strCode = _
"Private Sub CommandButton"&x-1&"_Click()" & vbCr & _
"' msgbox ""Адрес Row и Column ""&CStr(ActiveCell.Row)&"" ""&CStr(ActiveCell.Column)" & vbCr & _
"'Пишем принтеры"&vbCr & _
"Dim cn"&vbCr & _
"Dim rst"&vbCr & _
"Set cn=CreateObject(""ADODB.Connection"") "&vbCr & _
"Set rst=CreateObject(""ADODB.Recordset"")"&vbCr & _
"cn.open ""driver={SQL Server}; server=DBSERVER2\MNG; trusted_connection=yes; database=SpoolLog"" "&vbCr & _
"'Проверим статус соединения."&vbCr & _
"If cn.State=1 Then "&vbCr & _
"'Msgbox ""Connected"" "&vbCr & _
"else "&vbCr & _
"Msgbox ""Ошибка, не подключен SQL"" "&vbCr & _
"End If "&vbCr & _
"rst.open ""SELECT CONVERT(VarChar,TimeTask,20) as Time, UserName, NameTask, SumPages FROM LogTask Where PrnName='"&Replace(RSt.Fields(0).Value,"""","""""")&"' order by TimeTask"", cn"&vbCr & _
"Sheets.Add.Name="""&Replace(Left(Cstr(RSt.Fields(0).Value),15),"\","")&""""&vbCr & _
"x=1"&vbCr & _
" do until rst.eof"&vbCr & _
" ActiveCell.Offset(x, 0).FormulaR1C1 = Cstr(RSt.Fields(0).Value)"&vbCr & _
" ActiveCell.Offset(x, 1).FormulaR1C1 = Cstr(RSt.Fields(1).Value)"&vbCr & _
" ActiveCell.Offset(x, 2).FormulaR1C1 = Cstr(RSt.Fields(2).Value)"&vbCr & _
" ActiveCell.Offset(x, 3).FormulaR1C1 = Cstr(RSt.Fields(3).Value)"&vbCr & _
" x = x + 1 "&vbCr & _
" Rst.MoveNext "&vbCr & _
" Loop "&vbCr & _
"Rst.close"&vbCr & _
"ActiveCell.Offset(x, 3).FormulaR1C1 = ""=SUM(R[-""&CStr(x)&""]C:R[-1]C)"""&vbCr & _
"ActiveSheet.Columns(""A:D"").Select"&vbCr & _
"Selection.Columns.AutoFit"&vbCr & _
"end sub"
xlmodule.CodeModule.AddFromString strCode
objExcel.Cells(x, 1).Value = _
Cstr(RSt.Fields(0).Value)
objExcel.Cells(x, 2).Value = _
Cstr(RSt.Fields(1).Value)
objExcel.Cells(x, 3).Value = _
Cstr(RSt.Fields(2).Value)
x = x + 1
Rst.MoveNext
Loop
Rst.close
Set objRange = objExcel.Range("A1")
objRange.Activate
Set objRange = objExcel.ActiveCell.EntireColumn
objRange.Autofit()
Set objRange = objExcel.Range("A6")
objRange.Font.Bold = TRUE
Set objRange2 = objExcel.Range("A1")
objRange2.Font.Bold = TRUE
objRange2.Font.ColorIndex = 3
'Wscript.echo("Адрес ячейки: "+Cstr(ObjExcel.ActiveCell.Row))
'Получим адрес последней ячейки:
Last_Row=ObjExcel.Cells(1,1).SpecialCells(11).Row
End If
'Теперь пройдем циклом по машинкам - попробуем почитать у них стстояние.
x = x + 10
x=x+5
For i=7 to Last_row
'CheckSpoolLog(objExcel.Cells(i, 1).Value)
If Err.Number then
LogToExcel( "Ошибка при переборе I=" &Cstr(i)&" ошибка"&Cstr(Err.Number))
Err.Clear
End If
'If objExcel.Cells(i, 1).Value = "PTG-SERVER1" then CheckSpoolLog()
'If objExcel.Cells(i, 1).Value = "TERMINAL1" then CheckSpoolLog()
Next
objExcel.DisplayAlerts = false
'objExcel.Workbooks(1).saveas(Left(WScript.ScriptFullName,len(WScript.ScriptFullName)-len(WScript.ScriptName))&"Отчет.xls") 'Save the workbook, not excel file
'objExcel.Workbooks(1).Close 'Close the workbook then finally quit excel
'objExcel.Quit
Sub CheckSpoolLog(Name)
on error resume next
'Wscript.echo("Зашел в процедуру "+Cstr(objExcel.Cells(i, 1).Value))
'' Wscript.Echo "Отладка1Строка: " & strowner & Cstr(x)
'' Wscript.Echo "Отладка2Строка: " & Cstr(x)
lngNumEvents = objCollection.Count
If Err.Number>0 then
LogToExcel( "Для машинки в цикле ошибка" &Cstr(objExcel.Cells(i, 1).Value)&" ошибка"&Cstr(Err.Number))
Err.Clear
End If
If Err.Number>0 then
LogToExcel( "Для машинки по выходу из цикла ошибка" &Cstr(objExcel.Cells(i, 1).Value)&" ошибка"&Cstr(Err.Number))
objExcel.Cells(i, 6).Value ="Err"
objExcel.Cells(i, 7).Value =err.number
Err.Clear
Else
objExcel.Cells(i, 6).Value ="OK"
objExcel.Cells(i, 7).Value =err.number
End If
End Sub
Function WMIDateToString(dtmDate)
WMIDateToString = (Mid(dtmDate, 5, 2) & "/" & _
Mid(dtmDate, 7, 2) & "/" & _
Left(dtmDate, 4) & " " & _
Mid(dtmDate, 9, 2) & ":" & _
Mid(dtmDate, 11, 2) & ":" & _
Mid(dtmDate, 13, 2))
End Function
Function LogToExcel(TextLog)
objExcel.Cells(x, 7).Value = TextLog
x=x+1
End Function
Но это так, для отладки. Хотя пользоваться можно, только дописать в запросы ограничение по датам для выборки, а то все выгружает.
RootAdmin, спасибо, погляжу.
Такой вопрос, ответа на который не знаю: как добиться того, чтобы в журнал событий попадали события печати? У меня пусто, запрос
SELECT * FROM Win32_NTLogEvent WHERE Logfile='System' AND EventType=3 AND SourceName='Print' AND EventCode=10
возвращает пустую коллекцию.
А в свойствах сервера печати галка стоит?
В дополнительных параметрах, "Вести журнал сообщений очереди печати".
Нет, конечно , не стоит.
Страницы 1
Чтобы отправить ответ, вы должны войти или зарегистрироваться