nenrico
asked on
Printed Pages Counter
Hi, I need to write a program that will count the number of pages printed from each workstation. The program will be located in individual workstation, connected to a couple of networked printers. The purpose of this program is too see individual workstation user how many pages they have printed during the current financial year. All the workstations use Windows XP Pro.
I don't need to count the total pages printed on each printer nor the total of all pages printed, just pages printed in each workstation, intended to be available only to the workstation user. The nature of the program is only informational, not monitoring. Thanks!
I don't need to count the total pages printed on each printer nor the total of all pages printed, just pages printed in each workstation, intended to be available only to the workstation user. The nature of the program is only informational, not monitoring. Thanks!
Try to find code that will look into "Printer Spooler" service on local workstation, and when is there some job in local "Printer Spooler" service, you program will count one to some variable.
If you are good in programming, I think that this idea si very good and easy to use.
Adio!
If you are good in programming, I think that this idea si very good and easy to use.
Adio!
ASKER
Thanks for the input, guys. Unfortunately, I'm not that experienced in system programming and in windows environment. I've mostly done Java and PHP. You reckon this class would be useful?
http://msdn2.microsoft.com/EN-US/library/aa394288.aspx
http://msdn2.microsoft.com/EN-US/library/aa394288.aspx
there is some free software available that works well you will need to share out the folder where the data is stored.
http://www.papercut.biz/products/free_software/
http://www.papercut.biz/products/free_software/
I'm not sure how to code it, but if you're not against buying another program, I do know of a commercial package that would do the trick.
http://www.redline-software.com/eng/products/pam/
I haven't used it myself, and don't know what it costs - but there's a free trial you can download.
http://www.redline-software.com/eng/products/pam/
I haven't used it myself, and don't know what it costs - but there's a free trial you can download.
You could try print print audit 5.
<a href=" http://printaudit.com/trial.asp?nav=navuniv&SectionContent=trial">Here is the trail download</a>
It will count the pages printed on multiple workstations and over a network.
<a href=" http://printaudit.com/trial.asp?nav=navuniv&SectionContent=trial">Here is the trail download</a>
It will count the pages printed on multiple workstations and over a network.
Hi, I'm currently testing this script, but I haven't figured out if it's accurate yet......
'================
intSeconds = 1
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=imper sonate}!\\ " & strComputer & "\root\cimv2")
Set colMonitoredEvents = objWMIService.ExecNotifica tionQuery _
("SELECT * FROM __InstanceCreationEvent WITHIN " & intSeconds & " WHERE " _
& "TargetInstance ISA 'Win32_PrintJob'")
Set objShell = CreateObject("WScript.Shel l")
Do
Set objLatestEvent = colMonitoredEvents.NextEve nt
MsgBox "A print job was submitted within the last " & intSeconds & " seconds." & VbCrLf & _
"Caption: " & objLatestEvent.TargetInsta nce.Captio n & VbCrLf & _
"DataType: " & objLatestEvent.TargetInsta nce.DataTy pe & VbCrLf & _
"Description: " & objLatestEvent.TargetInsta nce.Descri ption & VbCrLf & _
"Document: " & objLatestEvent.TargetInsta nce.Docume nt & VbCrLf & _
"DriverName: " & objLatestEvent.TargetInsta nce.Driver Name & VbCrLf & _
"HostPrintQueue: " & objLatestEvent.TargetInsta nce.HostPr intQueue & VbCrLf & _
"JobId: " & objLatestEvent.TargetInsta nce.JobId & VbCrLf & _
"JobStatus: " & objLatestEvent.TargetInsta nce.JobSta tus & VbCrLf & _
"Name: " & objLatestEvent.TargetInsta nce.Name & VbCrLf & _
"Notify: " & objLatestEvent.TargetInsta nce.Notify & VbCrLf & _
"Owner: " & objLatestEvent.TargetInsta nce.Owner & VbCrLf & _
"PagesPrinted: " & objLatestEvent.TargetInsta nce.PagesP rinted & VbCrLf & _
"Parameters: " & objLatestEvent.TargetInsta nce.Parame ters & VbCrLf & _
"PrintProcessor: " & objLatestEvent.TargetInsta nce.PrintP rocessor & VbCrLf & _
"Priority: " & objLatestEvent.TargetInsta nce.Priori ty & VbCrLf & _
"Size: " & objLatestEvent.TargetInsta nce.Size & VbCrLf & _
"Status: " & objLatestEvent.TargetInsta nce.Status & VbCrLf & _
"StatusMask: " & objLatestEvent.TargetInsta nce.Status Mask & VbCrLf & _
"TotalPages: " & objLatestEvent.TargetInsta nce.TotalP ages _
, vbOKOnly, "Print Job Submitted"
Loop
'=============
It constantly runs, and needs to be terminated by ending the WScript.exe process from Task Manager.
Regards,
Rob.
'================
intSeconds = 1
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=imper
Set colMonitoredEvents = objWMIService.ExecNotifica
("SELECT * FROM __InstanceCreationEvent WITHIN " & intSeconds & " WHERE " _
& "TargetInstance ISA 'Win32_PrintJob'")
Set objShell = CreateObject("WScript.Shel
Do
Set objLatestEvent = colMonitoredEvents.NextEve
MsgBox "A print job was submitted within the last " & intSeconds & " seconds." & VbCrLf & _
"Caption: " & objLatestEvent.TargetInsta
"DataType: " & objLatestEvent.TargetInsta
"Description: " & objLatestEvent.TargetInsta
"Document: " & objLatestEvent.TargetInsta
"DriverName: " & objLatestEvent.TargetInsta
"HostPrintQueue: " & objLatestEvent.TargetInsta
"JobId: " & objLatestEvent.TargetInsta
"JobStatus: " & objLatestEvent.TargetInsta
"Name: " & objLatestEvent.TargetInsta
"Notify: " & objLatestEvent.TargetInsta
"Owner: " & objLatestEvent.TargetInsta
"PagesPrinted: " & objLatestEvent.TargetInsta
"Parameters: " & objLatestEvent.TargetInsta
"PrintProcessor: " & objLatestEvent.TargetInsta
"Priority: " & objLatestEvent.TargetInsta
"Size: " & objLatestEvent.TargetInsta
"Status: " & objLatestEvent.TargetInsta
"StatusMask: " & objLatestEvent.TargetInsta
"TotalPages: " & objLatestEvent.TargetInsta
, vbOKOnly, "Print Job Submitted"
Loop
'=============
It constantly runs, and needs to be terminated by ending the WScript.exe process from Task Manager.
Regards,
Rob.
This code that I have used does not seem entirely accurate, because the print job submitted may not contain exlicit page delimiters, meaning the TotalPages or PagesPrinted can be inaccurate.
Also, that link you posted to the Win32_PerfFormattedData_Sp ooler_Prin tQueue class only seems to report absolute total pages *from* the print server, not a client, and therefore is a total amount of pages printer (since the last reboot) for each printer, for everyone.
I'm still looking.......but the chances are getting smaller for a free monitor, by the look of it.....
Regards,
Rob.
Also, that link you posted to the Win32_PerfFormattedData_Sp
I'm still looking.......but the chances are getting smaller for a free monitor, by the look of it.....
Regards,
Rob.
If these are network printers you could write code to look through the System Event logs grab all the print ID's and get the number of pages printer by workstation that way. There are still a lot of variable with that approach, like how big are the log files and what is you retention policy or log file size. you could write an access database to look through the log file (at a specified time every day and look back 24 hours), grab any EventID:10. This will give you who printed it, what ip address is was printed from, the document name, the file size and the total and the number of pages for that print job. It's not perfect but it will work.
wdkittle, what a great idea! I forgot about the Print events in the System log. You could use the below script, and just parse the objEvent.Message string to get the details you needed. Then you could run it once a day, and as this script gets the details from *yesterday*, you would know who printed what, on which printer, yesterday.
'==============
dteStartTime = DateAdd("d", -1, Now)
strTimeBias = Get_CurrentTimeZone_Of_Com puter(".")
strTimeBias = "+" & strTimeBias
strDateFrom = Year(dteStartTime) & Pad_String(Month(dteStartT ime), 2, "Left", "0") & Pad_String(Day(dteStartTim e), 2, "Left", "0") & "000000.000000" & strTimeBias
strDateTo = Year(dteStartTime) & Pad_String(Month(dteStartT ime), 2, "Left", "0") & Pad_String(Day(dteStartTim e), 2, "Left", "0") & "235959.000000" & strTimeBias
strServerLog = ""
strComputer = InputBox("Please enter the host name of the print server to get Print Job information from:", "Print Server", "MCCDC02")
If Ping(strComputer) = True Then
Set objWMI = GetObject("winmgmts:{imper sonationLe vel=impers onate}!\\" & strComputer & "\root\cimv2")
strServerTimeBias = Get_CurrentTimeZone_Of_Com puter(strC omputer)
strServerTimeBias = "+" & strServerTimeBias
If Not strTimeBias = strServerTimeBias Then
MsgBox "Time Bias on local machine: " & strTimeBias & vbCrLf & _
"Time Bias on " & strComputer & ": " & strServerTimeBias & vbCrLf & _
"Please check why these are different then re-run this application."
Else
strLogName = "System"
' Event Types: 1 = Error ; 2 = Warning ; 3 = Information ; 4 = Security audit success ; 5 = Security audit failure
Set colLoggedEvents = objWMI.ExecQuery _
("SELECT * FROM Win32_NTLogEvent WHERE LogFile = '" & strLogName & _
"' AND EventType = 3 AND EventCode = 10 AND SourceName = 'Print' AND TimeWritten >= '" & _
strDateFrom & "' AND TimeWritten <= '" & strDateTo & "'", "WQL", _
wbemFlagReturnImmediately + wbemFlagForwardOnly)
On Error Resume Next
For Each objEvent in colLoggedEvents
If Err.Number = 0 Then
On Error GoTo 0
strDate = Left(objEvent.TimeWritten, 8)
strDate = Right(strDate, 2) & "-" & Mid(strDate, 5, 2) & "-" & Left(strDate, 4)
dteDate = CDate(strDate)
strTime = Mid(objEvent.TimeWritten, 9, 6)
strTime = Left(strTime, 2) & ":" & Mid(strTime, 3, 2) & ":" & Right(strTime, 2)
dteTime = CDate(strTime)
strEventType = objEvent.EventType
Select Case strEventType
Case 1
strEventType = "Error"
Case 2
strEventType = "Warning"
Case 3
strEventType = "Information"
Case 4
strEventType = "Audit Success"
Case 5
strEventType = "Audit Failure"
Case Else
strEventType = "CODE " & objEvent.EventType & " = " & objEvent.Type
End Select
strUser = objEvent.User
If strUser = "" Then
strUser = "N/A"
End If
If IsNull(objEvent.CategorySt ring) Then
strCategory = "None"
Else
strCategory = objEvent.CategoryString
End If
If InStr(objEvent.Message, "^|^") > 0 Then
MsgBox "There is an extra pipe character (^|^) in the event log." & vbCrLf & objEvent.Message
ElseIf InStr(objEvent.Message, "^;^") > 0 Then
MsgBox "There is an extra semi-colon character (^;^) in the event log." & vbCrLf & objEvent.Message
Else
strServerLog = strServerLog & strComputer & "^;^" & objEvent.LogFile & "^;^" & dteDate & "^;^" & dteTime & "^;^" & strEventType & _
"^;^" & strUser & "^;^" & objEvent.SourceName & "^;^" & strCategory & "^;^" & objEvent.EventCode & "^;^" & objEvent.Message & "^|^"
End If
Else
MsgBox "Unknown Error for the " & strLogName & " Log on " & strComputer & "." & vbCrLf & "Error Number: " & _
Err.Number & vbCrLf & "Error Description: " & Err.Description, vbOKOnly, "Unknown Error"
Err.Clear
On Error GoTo 0
Exit For
End If
Next
End If
Else
MsgBox strComputer & " did not respond to ping."
End If
If Right(strServerLog, 3) = "^|^" Then strServerLog = Left(strServerLog, Len(strServerLog) - 3)
If InStr(strServerLog, "^;^") > 0 Then
arrEvents = Split(strServerLog, "^|^")
For Each strEvent In arrEvents
MsgBox Join(Split(strEvent, "^;^"), VbCrLf)
Next
Else
MsgBox "No event were found on " & strComputer
End If
MsgBox "Done"
Function Get_CurrentTimeZone_Of_Com puter(byva l strComputerName)
Dim objWMIService, colLogFiles, objLogFile, intTotal, colItems, objItem, strCurrentTimeZone
Const wbemFlagReturnImmediately = &h10
Const wbemFlagForwardOnly = &h20
Set objWMIService = GetObject("winmgmts:{imper sonationLe vel=impers onate}!\\" & _
strComputerName & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("S elect CurrentTimeZone from Win32_OperatingSystem",,48 )
On Error Resume Next
For Each objItem in colItems
If Err.Number = 0 Then
On Error GoTo 0
strCurrentTimeZone = objItem.CurrentTimeZone
Exit For
Else
MsgBox "Unknown Error during Time Bias for " & strComputer & "." & vbCrLf & "Error Number: " & _
Err.Number & vbCrLf & "Error Description: " & Err.Description, vbOKOnly, "Unknown Error"
Err.Clear
On Error GoTo 0
Exit For
End If
Next
On Error GoTo 0
Get_CurrentTimeZone_Of_Com puter = strCurrentTimeZone
End Function
Function Ping(strComputer)
Dim objShell, boolCode
Set objShell = CreateObject("WScript.Shel l")
boolCode = objShell.Run("Ping -n 1 -w 300 " & strComputer, 0, True)
If boolCode = 0 Then
Ping = True
Else
Ping = False
End If
End Function
Function Pad_String(strOriginalStri ng, intTotalLengthRequired, strPaddingSide, strCharacterToPadWith)
If LCase(strPaddingSide) <> "left" And LCase(strPaddingSide) <> "right" Then
strPaddingSide = "right"
End If
Select Case LCase(strPaddingSide)
Case "left"
Pad_String = Right(String(intTotalLengt hRequired, Left(strCharacterToPadWith , 1)) & strOriginalString, intTotalLengthRequired)
Case "right"
Pad_String = Left(strOriginalString & String(intTotalLengthRequi red, Left(strCharacterToPadWith , 1)), intTotalLengthRequired)
End Select
End Function
'==============
I'll work some more on this tomorrow.
Regards,
Rob.
'==============
dteStartTime = DateAdd("d", -1, Now)
strTimeBias = Get_CurrentTimeZone_Of_Com
strTimeBias = "+" & strTimeBias
strDateFrom = Year(dteStartTime) & Pad_String(Month(dteStartT
strDateTo = Year(dteStartTime) & Pad_String(Month(dteStartT
strServerLog = ""
strComputer = InputBox("Please enter the host name of the print server to get Print Job information from:", "Print Server", "MCCDC02")
If Ping(strComputer) = True Then
Set objWMI = GetObject("winmgmts:{imper
strServerTimeBias = Get_CurrentTimeZone_Of_Com
strServerTimeBias = "+" & strServerTimeBias
If Not strTimeBias = strServerTimeBias Then
MsgBox "Time Bias on local machine: " & strTimeBias & vbCrLf & _
"Time Bias on " & strComputer & ": " & strServerTimeBias & vbCrLf & _
"Please check why these are different then re-run this application."
Else
strLogName = "System"
' Event Types: 1 = Error ; 2 = Warning ; 3 = Information ; 4 = Security audit success ; 5 = Security audit failure
Set colLoggedEvents = objWMI.ExecQuery _
("SELECT * FROM Win32_NTLogEvent WHERE LogFile = '" & strLogName & _
"' AND EventType = 3 AND EventCode = 10 AND SourceName = 'Print' AND TimeWritten >= '" & _
strDateFrom & "' AND TimeWritten <= '" & strDateTo & "'", "WQL", _
wbemFlagReturnImmediately + wbemFlagForwardOnly)
On Error Resume Next
For Each objEvent in colLoggedEvents
If Err.Number = 0 Then
On Error GoTo 0
strDate = Left(objEvent.TimeWritten,
strDate = Right(strDate, 2) & "-" & Mid(strDate, 5, 2) & "-" & Left(strDate, 4)
dteDate = CDate(strDate)
strTime = Mid(objEvent.TimeWritten, 9, 6)
strTime = Left(strTime, 2) & ":" & Mid(strTime, 3, 2) & ":" & Right(strTime, 2)
dteTime = CDate(strTime)
strEventType = objEvent.EventType
Select Case strEventType
Case 1
strEventType = "Error"
Case 2
strEventType = "Warning"
Case 3
strEventType = "Information"
Case 4
strEventType = "Audit Success"
Case 5
strEventType = "Audit Failure"
Case Else
strEventType = "CODE " & objEvent.EventType & " = " & objEvent.Type
End Select
strUser = objEvent.User
If strUser = "" Then
strUser = "N/A"
End If
If IsNull(objEvent.CategorySt
strCategory = "None"
Else
strCategory = objEvent.CategoryString
End If
If InStr(objEvent.Message, "^|^") > 0 Then
MsgBox "There is an extra pipe character (^|^) in the event log." & vbCrLf & objEvent.Message
ElseIf InStr(objEvent.Message, "^;^") > 0 Then
MsgBox "There is an extra semi-colon character (^;^) in the event log." & vbCrLf & objEvent.Message
Else
strServerLog = strServerLog & strComputer & "^;^" & objEvent.LogFile & "^;^" & dteDate & "^;^" & dteTime & "^;^" & strEventType & _
"^;^" & strUser & "^;^" & objEvent.SourceName & "^;^" & strCategory & "^;^" & objEvent.EventCode & "^;^" & objEvent.Message & "^|^"
End If
Else
MsgBox "Unknown Error for the " & strLogName & " Log on " & strComputer & "." & vbCrLf & "Error Number: " & _
Err.Number & vbCrLf & "Error Description: " & Err.Description, vbOKOnly, "Unknown Error"
Err.Clear
On Error GoTo 0
Exit For
End If
Next
End If
Else
MsgBox strComputer & " did not respond to ping."
End If
If Right(strServerLog, 3) = "^|^" Then strServerLog = Left(strServerLog, Len(strServerLog) - 3)
If InStr(strServerLog, "^;^") > 0 Then
arrEvents = Split(strServerLog, "^|^")
For Each strEvent In arrEvents
MsgBox Join(Split(strEvent, "^;^"), VbCrLf)
Next
Else
MsgBox "No event were found on " & strComputer
End If
MsgBox "Done"
Function Get_CurrentTimeZone_Of_Com
Dim objWMIService, colLogFiles, objLogFile, intTotal, colItems, objItem, strCurrentTimeZone
Const wbemFlagReturnImmediately = &h10
Const wbemFlagForwardOnly = &h20
Set objWMIService = GetObject("winmgmts:{imper
strComputerName & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("S
On Error Resume Next
For Each objItem in colItems
If Err.Number = 0 Then
On Error GoTo 0
strCurrentTimeZone = objItem.CurrentTimeZone
Exit For
Else
MsgBox "Unknown Error during Time Bias for " & strComputer & "." & vbCrLf & "Error Number: " & _
Err.Number & vbCrLf & "Error Description: " & Err.Description, vbOKOnly, "Unknown Error"
Err.Clear
On Error GoTo 0
Exit For
End If
Next
On Error GoTo 0
Get_CurrentTimeZone_Of_Com
End Function
Function Ping(strComputer)
Dim objShell, boolCode
Set objShell = CreateObject("WScript.Shel
boolCode = objShell.Run("Ping -n 1 -w 300 " & strComputer, 0, True)
If boolCode = 0 Then
Ping = True
Else
Ping = False
End If
End Function
Function Pad_String(strOriginalStri
If LCase(strPaddingSide) <> "left" And LCase(strPaddingSide) <> "right" Then
strPaddingSide = "right"
End If
Select Case LCase(strPaddingSide)
Case "left"
Pad_String = Right(String(intTotalLengt
Case "right"
Pad_String = Left(strOriginalString & String(intTotalLengthRequi
End Select
End Function
'==============
I'll work some more on this tomorrow.
Regards,
Rob.
Hi, here's another re-work that checks the print jobs from yesterday for a given print server, and outputs the details to a CSV file separated by semi-colons, called Results.csv
'========
dteStartTime = DateAdd("d", -1, Now)
strTimeBias = Get_CurrentTimeZone_Of_Com puter(".")
strTimeBias = "+" & strTimeBias
strDateFrom = Year(dteStartTime) & Pad_String(Month(dteStartT ime), 2, "Left", "0") & Pad_String(Day(dteStartTim e), 2, "Left", "0") & "000000.000000" & strTimeBias
strDateTo = Year(dteStartTime) & Pad_String(Month(dteStartT ime), 2, "Left", "0") & Pad_String(Day(dteStartTim e), 2, "Left", "0") & "235959.000000" & strTimeBias
strServerLog = ""
strComputer = InputBox("Please enter the host name of the print server to get Print Job information from:", "Print Server", "MCCDC02")
If Ping(strComputer) = True Then
Set objWMI = GetObject("winmgmts:{imper sonationLe vel=impers onate}!\\" & strComputer & "\root\cimv2")
strServerTimeBias = Get_CurrentTimeZone_Of_Com puter(strC omputer)
strServerTimeBias = "+" & strServerTimeBias
If Not strTimeBias = strServerTimeBias Then
MsgBox "Time Bias on local machine: " & strTimeBias & vbCrLf & _
"Time Bias on " & strComputer & ": " & strServerTimeBias & vbCrLf & _
"Please check why these are different then re-run this application."
Else
strLogName = "System"
' Event Types: 1 = Error ; 2 = Warning ; 3 = Information ; 4 = Security audit success ; 5 = Security audit failure
Set colLoggedEvents = objWMI.ExecQuery _
("SELECT * FROM Win32_NTLogEvent WHERE LogFile = '" & strLogName & _
"' AND EventType = 3 AND EventCode = 10 AND SourceName = 'Print' AND TimeWritten >= '" & _
strDateFrom & "' AND TimeWritten <= '" & strDateTo & "'", "WQL", _
wbemFlagReturnImmediately + wbemFlagForwardOnly)
On Error Resume Next
For Each objEvent in colLoggedEvents
If Err.Number = 0 Then
On Error GoTo 0
strDate = Left(objEvent.TimeWritten, 8)
strDate = Right(strDate, 2) & "-" & Mid(strDate, 5, 2) & "-" & Left(strDate, 4)
dteDate = CDate(strDate)
strTime = Mid(objEvent.TimeWritten, 9, 6)
strTime = Left(strTime, 2) & ":" & Mid(strTime, 3, 2) & ":" & Right(strTime, 2)
dteTime = CDate(strTime)
strEventType = objEvent.EventType
Select Case strEventType
Case 1
strEventType = "Error"
Case 2
strEventType = "Warning"
Case 3
strEventType = "Information"
Case 4
strEventType = "Audit Success"
Case 5
strEventType = "Audit Failure"
Case Else
strEventType = "CODE " & objEvent.EventType & " = " & objEvent.Type
End Select
strUser = objEvent.User
If strUser = "" Then
strUser = "N/A"
End If
If IsNull(objEvent.CategorySt ring) Then
strCategory = "None"
Else
strCategory = objEvent.CategoryString
End If
If InStr(objEvent.Message, "^|^") > 0 Then
MsgBox "There is an extra pipe character (^|^) in the event log." & vbCrLf & objEvent.Message
ElseIf InStr(objEvent.Message, "^;^") > 0 Then
MsgBox "There is an extra semi-colon character (^;^) in the event log." & vbCrLf & objEvent.Message
Else
'Document 218, Micorosoft Word - Document.doc owned by Awhite was printed on Engineer 8150 via port 172.16.1.182. Size in bytes: 11492; pages printed: 1
strDocNumber = Mid(objEvent.Message, InStr(objEvent.Message, "Document ") + 9, InStr(objEvent.Message, ",") - 10)
strDocName = Mid(objEvent.Message, InStr(objEvent.Message, ", ") + 2, InStr(objEvent.Message, " owned by ") - InStr(objEvent.Message, ", ") - 2)
strOwnedBy = Mid(objEvent.Message, InStr(objEvent.Message, " owned by ") + 10, InStr(objEvent.Message, " was printed on ") - InStr(objEvent.Message, " owned by ") - 10)
strPrinterName = Mid(objEvent.Message, InStr(objEvent.Message, " was printed on ") + 16, InStr(objEvent.Message, " via port ") - InStr(objEvent.Message, " was printed on ") - 16)
strPortName = Mid(objEvent.Message, InStr(objEvent.Message, " via port ") + 10, InStr(objEvent.Message, ". Size in bytes: ") - InStr(objEvent.Message, " via port ") - 10)
strSizeInBytes = Mid(objEvent.Message, InStr(objEvent.Message, ". Size in bytes: ") + 18, InStr(objEvent.Message, "; pages printed: ") - InStr(objEvent.Message, ". Size in bytes: ") - 18)
strPagesPrinted = Mid(objEvent.Message, InStr(objEvent.Message, "; pages printed: ") + 17)
strPrintDetails = strDocNumber & "^;^" & strDocName & "^;^" & strOwnedBy & "^;^" & strPrinterName & "^;^" & strPortName & "^;^" & strSizeInBytes & "^;^" & strPagesPrinted
strServerLog = strServerLog & strComputer & "^;^" & objEvent.LogFile & "^;^" & dteDate & "^;^" & dteTime & "^;^" & strEventType & _
"^;^" & strUser & "^;^" & objEvent.SourceName & "^;^" & strCategory & "^;^" & objEvent.EventCode & "^;^" & strPrintDetails & "^|^"
End If
Else
MsgBox "Unknown Error for the " & strLogName & " Log on " & strComputer & "." & vbCrLf & "Error Number: " & _
Err.Number & vbCrLf & "Error Description: " & Err.Description, vbOKOnly, "Unknown Error"
Err.Clear
On Error GoTo 0
Exit For
End If
Next
End If
Else
MsgBox strComputer & " did not respond to ping."
End If
If Right(strServerLog, 3) = "^|^" Then strServerLog = Left(strServerLog, Len(strServerLog) - 3)
If InStr(strServerLog, "^;^") > 0 Then
Set objFSO = CreateObject("Scripting.Fi leSystemOb ject")
Set objOutputFile = objFSO.CreateTextFile("Res ults.csv", True)
objOutputFile.Write "Computer;Log File;Date;Time;Event Type;User;Source;Category; Event ID;Doc Number;Doc Name;Owner;Printer;Port;Si ze;Pages"
arrEvents = Split(strServerLog, "^|^")
For intCount = LBound(arrEvents) To UBound(arrEvents)
'MsgBox Join(Split(arrEvents(intCo unt), "^;^"), ";")
objOutputFile.Write Join(Split(arrEvents(intCo unt), "^;^"), ";")
Next
objOutputFile.Close
Set objOutputFile = Nothing
Set objFSO = Nothing
Else
MsgBox "No event were found on " & strComputer
End If
MsgBox "Done"
Function Get_CurrentTimeZone_Of_Com puter(byva l strComputerName)
Dim objWMIService, colLogFiles, objLogFile, intTotal, colItems, objItem, strCurrentTimeZone
Const wbemFlagReturnImmediately = &h10
Const wbemFlagForwardOnly = &h20
Set objWMIService = GetObject("winmgmts:{imper sonationLe vel=impers onate}!\\" & _
strComputerName & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("S elect CurrentTimeZone from Win32_OperatingSystem",,48 )
On Error Resume Next
For Each objItem in colItems
If Err.Number = 0 Then
On Error GoTo 0
strCurrentTimeZone = objItem.CurrentTimeZone
Exit For
Else
MsgBox "Unknown Error during Time Bias for " & strComputer & "." & vbCrLf & "Error Number: " & _
Err.Number & vbCrLf & "Error Description: " & Err.Description, vbOKOnly, "Unknown Error"
Err.Clear
On Error GoTo 0
Exit For
End If
Next
On Error GoTo 0
Get_CurrentTimeZone_Of_Com puter = strCurrentTimeZone
End Function
Function Ping(strComputer)
Dim objShell, boolCode
Set objShell = CreateObject("WScript.Shel l")
boolCode = objShell.Run("Ping -n 1 -w 300 " & strComputer, 0, True)
If boolCode = 0 Then
Ping = True
Else
Ping = False
End If
End Function
Function Pad_String(strOriginalStri ng, intTotalLengthRequired, strPaddingSide, strCharacterToPadWith)
If LCase(strPaddingSide) <> "left" And LCase(strPaddingSide) <> "right" Then
strPaddingSide = "right"
End If
Select Case LCase(strPaddingSide)
Case "left"
Pad_String = Right(String(intTotalLengt hRequired, Left(strCharacterToPadWith , 1)) & strOriginalString, intTotalLengthRequired)
Case "right"
Pad_String = Left(strOriginalString & String(intTotalLengthRequi red, Left(strCharacterToPadWith , 1)), intTotalLengthRequired)
End Select
End Function
'========
Regards,
Rob.
'========
dteStartTime = DateAdd("d", -1, Now)
strTimeBias = Get_CurrentTimeZone_Of_Com
strTimeBias = "+" & strTimeBias
strDateFrom = Year(dteStartTime) & Pad_String(Month(dteStartT
strDateTo = Year(dteStartTime) & Pad_String(Month(dteStartT
strServerLog = ""
strComputer = InputBox("Please enter the host name of the print server to get Print Job information from:", "Print Server", "MCCDC02")
If Ping(strComputer) = True Then
Set objWMI = GetObject("winmgmts:{imper
strServerTimeBias = Get_CurrentTimeZone_Of_Com
strServerTimeBias = "+" & strServerTimeBias
If Not strTimeBias = strServerTimeBias Then
MsgBox "Time Bias on local machine: " & strTimeBias & vbCrLf & _
"Time Bias on " & strComputer & ": " & strServerTimeBias & vbCrLf & _
"Please check why these are different then re-run this application."
Else
strLogName = "System"
' Event Types: 1 = Error ; 2 = Warning ; 3 = Information ; 4 = Security audit success ; 5 = Security audit failure
Set colLoggedEvents = objWMI.ExecQuery _
("SELECT * FROM Win32_NTLogEvent WHERE LogFile = '" & strLogName & _
"' AND EventType = 3 AND EventCode = 10 AND SourceName = 'Print' AND TimeWritten >= '" & _
strDateFrom & "' AND TimeWritten <= '" & strDateTo & "'", "WQL", _
wbemFlagReturnImmediately + wbemFlagForwardOnly)
On Error Resume Next
For Each objEvent in colLoggedEvents
If Err.Number = 0 Then
On Error GoTo 0
strDate = Left(objEvent.TimeWritten,
strDate = Right(strDate, 2) & "-" & Mid(strDate, 5, 2) & "-" & Left(strDate, 4)
dteDate = CDate(strDate)
strTime = Mid(objEvent.TimeWritten, 9, 6)
strTime = Left(strTime, 2) & ":" & Mid(strTime, 3, 2) & ":" & Right(strTime, 2)
dteTime = CDate(strTime)
strEventType = objEvent.EventType
Select Case strEventType
Case 1
strEventType = "Error"
Case 2
strEventType = "Warning"
Case 3
strEventType = "Information"
Case 4
strEventType = "Audit Success"
Case 5
strEventType = "Audit Failure"
Case Else
strEventType = "CODE " & objEvent.EventType & " = " & objEvent.Type
End Select
strUser = objEvent.User
If strUser = "" Then
strUser = "N/A"
End If
If IsNull(objEvent.CategorySt
strCategory = "None"
Else
strCategory = objEvent.CategoryString
End If
If InStr(objEvent.Message, "^|^") > 0 Then
MsgBox "There is an extra pipe character (^|^) in the event log." & vbCrLf & objEvent.Message
ElseIf InStr(objEvent.Message, "^;^") > 0 Then
MsgBox "There is an extra semi-colon character (^;^) in the event log." & vbCrLf & objEvent.Message
Else
'Document 218, Micorosoft Word - Document.doc owned by Awhite was printed on Engineer 8150 via port 172.16.1.182. Size in bytes: 11492; pages printed: 1
strDocNumber = Mid(objEvent.Message, InStr(objEvent.Message, "Document ") + 9, InStr(objEvent.Message, ",") - 10)
strDocName = Mid(objEvent.Message, InStr(objEvent.Message, ", ") + 2, InStr(objEvent.Message, " owned by ") - InStr(objEvent.Message, ", ") - 2)
strOwnedBy = Mid(objEvent.Message, InStr(objEvent.Message, " owned by ") + 10, InStr(objEvent.Message, " was printed on ") - InStr(objEvent.Message, " owned by ") - 10)
strPrinterName = Mid(objEvent.Message, InStr(objEvent.Message, " was printed on ") + 16, InStr(objEvent.Message, " via port ") - InStr(objEvent.Message, " was printed on ") - 16)
strPortName = Mid(objEvent.Message, InStr(objEvent.Message, " via port ") + 10, InStr(objEvent.Message, ". Size in bytes: ") - InStr(objEvent.Message, " via port ") - 10)
strSizeInBytes = Mid(objEvent.Message, InStr(objEvent.Message, ". Size in bytes: ") + 18, InStr(objEvent.Message, "; pages printed: ") - InStr(objEvent.Message, ". Size in bytes: ") - 18)
strPagesPrinted = Mid(objEvent.Message, InStr(objEvent.Message, "; pages printed: ") + 17)
strPrintDetails = strDocNumber & "^;^" & strDocName & "^;^" & strOwnedBy & "^;^" & strPrinterName & "^;^" & strPortName & "^;^" & strSizeInBytes & "^;^" & strPagesPrinted
strServerLog = strServerLog & strComputer & "^;^" & objEvent.LogFile & "^;^" & dteDate & "^;^" & dteTime & "^;^" & strEventType & _
"^;^" & strUser & "^;^" & objEvent.SourceName & "^;^" & strCategory & "^;^" & objEvent.EventCode & "^;^" & strPrintDetails & "^|^"
End If
Else
MsgBox "Unknown Error for the " & strLogName & " Log on " & strComputer & "." & vbCrLf & "Error Number: " & _
Err.Number & vbCrLf & "Error Description: " & Err.Description, vbOKOnly, "Unknown Error"
Err.Clear
On Error GoTo 0
Exit For
End If
Next
End If
Else
MsgBox strComputer & " did not respond to ping."
End If
If Right(strServerLog, 3) = "^|^" Then strServerLog = Left(strServerLog, Len(strServerLog) - 3)
If InStr(strServerLog, "^;^") > 0 Then
Set objFSO = CreateObject("Scripting.Fi
Set objOutputFile = objFSO.CreateTextFile("Res
objOutputFile.Write "Computer;Log File;Date;Time;Event Type;User;Source;Category;
arrEvents = Split(strServerLog, "^|^")
For intCount = LBound(arrEvents) To UBound(arrEvents)
'MsgBox Join(Split(arrEvents(intCo
objOutputFile.Write Join(Split(arrEvents(intCo
Next
objOutputFile.Close
Set objOutputFile = Nothing
Set objFSO = Nothing
Else
MsgBox "No event were found on " & strComputer
End If
MsgBox "Done"
Function Get_CurrentTimeZone_Of_Com
Dim objWMIService, colLogFiles, objLogFile, intTotal, colItems, objItem, strCurrentTimeZone
Const wbemFlagReturnImmediately = &h10
Const wbemFlagForwardOnly = &h20
Set objWMIService = GetObject("winmgmts:{imper
strComputerName & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("S
On Error Resume Next
For Each objItem in colItems
If Err.Number = 0 Then
On Error GoTo 0
strCurrentTimeZone = objItem.CurrentTimeZone
Exit For
Else
MsgBox "Unknown Error during Time Bias for " & strComputer & "." & vbCrLf & "Error Number: " & _
Err.Number & vbCrLf & "Error Description: " & Err.Description, vbOKOnly, "Unknown Error"
Err.Clear
On Error GoTo 0
Exit For
End If
Next
On Error GoTo 0
Get_CurrentTimeZone_Of_Com
End Function
Function Ping(strComputer)
Dim objShell, boolCode
Set objShell = CreateObject("WScript.Shel
boolCode = objShell.Run("Ping -n 1 -w 300 " & strComputer, 0, True)
If boolCode = 0 Then
Ping = True
Else
Ping = False
End If
End Function
Function Pad_String(strOriginalStri
If LCase(strPaddingSide) <> "left" And LCase(strPaddingSide) <> "right" Then
strPaddingSide = "right"
End If
Select Case LCase(strPaddingSide)
Case "left"
Pad_String = Right(String(intTotalLengt
Case "right"
Pad_String = Left(strOriginalString & String(intTotalLengthRequi
End Select
End Function
'========
Regards,
Rob.
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
nenrico, does my solution help you with this problem at all?
Regards,
Rob.
Regards,
Rob.
Forced accept.
Computer101
EE Admin
Computer101
EE Admin
Off the top of my head, from a client point of view, you would have to constantly run a script to monitor for a print job, using something like this:
Set colMonitoredEvents = objWMIService.ExecNotifica
("SELECT * FROM __InstanceModificationEven
& "TargetInstance ISA 'Win32_PrintJob'")
But I'm not sure of this..... I don't have time to test anything right now....
Regards,
Rob.