SELECT * FROM Win32_NTLogEvent WHERE Logfile='System' AND EventType=3 AND SourceName='Print' AND EventCode=10

'  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&" равно "&LTimeRec)    

'Теперь запись точно есть
'Можно отправляться в процедуру и заполнять таблицу задач используя в качестве параметров запроса 
'в качестве даты начала  - дату из запроса 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())  )&" часов назад, записано: "&LTimeRec  )
 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

'cn.open "uid=DOMAIN\admin;pwd=**********; driver={SQL Server}; server=DBSERVER2\MNG; database=SpoolLog"

& "'LDAP://dc=DOMAIN,dc=ru' WHERE " _

'  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

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