• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 721
  • Last Modified:

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!
0
nenrico
Asked:
nenrico
1 Solution
 
RobSampsonCommented:
This would be very tricky.

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.ExecNotificationQuery _
("SELECT * FROM __InstanceModificationEvent WITHIN 3 WHERE " _
& "TargetInstance ISA 'Win32_PrintJob'")

But I'm not sure of this..... I don't have time to test anything right now....

Regards,

Rob.
0
 
Cro0707Commented:
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!
0
 
nenricoAuthor Commented:
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
0
Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

 
BPWALKINCommented:
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/

0
 
ClawfootSupplyCommented:
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.
0
 
RobantorCommented:
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.
0
 
RobSampsonCommented:
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=impersonate}!\\" & strComputer & "\root\cimv2")

Set colMonitoredEvents = objWMIService.ExecNotificationQuery _
      ("SELECT * FROM __InstanceCreationEvent WITHIN " & intSeconds & " WHERE " _
      & "TargetInstance ISA 'Win32_PrintJob'")

Set objShell = CreateObject("WScript.Shell")

Do
Set objLatestEvent = colMonitoredEvents.NextEvent
      MsgBox "A print job was submitted within the last " & intSeconds & " seconds." & VbCrLf & _
    "Caption: " & objLatestEvent.TargetInstance.Caption & VbCrLf & _
      "DataType: " & objLatestEvent.TargetInstance.DataType & VbCrLf & _
      "Description: " & objLatestEvent.TargetInstance.Description & VbCrLf & _
      "Document: " & objLatestEvent.TargetInstance.Document & VbCrLf & _
      "DriverName: " & objLatestEvent.TargetInstance.DriverName & VbCrLf & _
      "HostPrintQueue: " & objLatestEvent.TargetInstance.HostPrintQueue & VbCrLf & _
      "JobId: " & objLatestEvent.TargetInstance.JobId & VbCrLf & _
      "JobStatus: " & objLatestEvent.TargetInstance.JobStatus & VbCrLf & _
      "Name: " & objLatestEvent.TargetInstance.Name & VbCrLf & _
      "Notify: " & objLatestEvent.TargetInstance.Notify & VbCrLf & _
      "Owner: " & objLatestEvent.TargetInstance.Owner & VbCrLf & _
      "PagesPrinted: " & objLatestEvent.TargetInstance.PagesPrinted & VbCrLf & _
      "Parameters: " & objLatestEvent.TargetInstance.Parameters & VbCrLf & _
      "PrintProcessor: " & objLatestEvent.TargetInstance.PrintProcessor & VbCrLf & _
      "Priority: " & objLatestEvent.TargetInstance.Priority & VbCrLf & _
      "Size: " & objLatestEvent.TargetInstance.Size & VbCrLf & _
      "Status: " & objLatestEvent.TargetInstance.Status & VbCrLf & _
      "StatusMask: " & objLatestEvent.TargetInstance.StatusMask & VbCrLf & _
      "TotalPages: " & objLatestEvent.TargetInstance.TotalPages _
      , vbOKOnly, "Print Job Submitted"
Loop
'=============

It constantly runs, and needs to be terminated by ending the WScript.exe process from Task Manager.

Regards,

Rob.
0
 
RobSampsonCommented:
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_Spooler_PrintQueue 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.
0
 
wdkittleCommented:
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.
0
 
RobSampsonCommented:
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_Computer(".")
strTimeBias = "+" & strTimeBias

strDateFrom = Year(dteStartTime) & Pad_String(Month(dteStartTime), 2, "Left", "0") & Pad_String(Day(dteStartTime), 2, "Left", "0") & "000000.000000" & strTimeBias
strDateTo = Year(dteStartTime) & Pad_String(Month(dteStartTime), 2, "Left", "0") & Pad_String(Day(dteStartTime), 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:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
      strServerTimeBias = Get_CurrentTimeZone_Of_Computer(strComputer)
      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.CategoryString) 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_Computer(byval strComputerName)

      Dim objWMIService, colLogFiles, objLogFile, intTotal, colItems, objItem, strCurrentTimeZone
      Const wbemFlagReturnImmediately = &h10
      Const wbemFlagForwardOnly = &h20

      Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
              strComputerName & "\root\cimv2")

      Set colItems = objWMIService.ExecQuery("Select 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_Computer = strCurrentTimeZone
      
End Function

Function Ping(strComputer)
      Dim objShell, boolCode
      Set objShell = CreateObject("WScript.Shell")
      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(strOriginalString, 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(intTotalLengthRequired, Left(strCharacterToPadWith, 1)) & strOriginalString, intTotalLengthRequired)
            Case "right"
                  Pad_String = Left(strOriginalString & String(intTotalLengthRequired, Left(strCharacterToPadWith, 1)), intTotalLengthRequired)
      End Select
End Function
'==============

I'll work some more on this tomorrow.

Regards,

Rob.
0
 
RobSampsonCommented:
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_Computer(".")
strTimeBias = "+" & strTimeBias

strDateFrom = Year(dteStartTime) & Pad_String(Month(dteStartTime), 2, "Left", "0") & Pad_String(Day(dteStartTime), 2, "Left", "0") & "000000.000000" & strTimeBias
strDateTo = Year(dteStartTime) & Pad_String(Month(dteStartTime), 2, "Left", "0") & Pad_String(Day(dteStartTime), 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:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
      strServerTimeBias = Get_CurrentTimeZone_Of_Computer(strComputer)
      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.CategoryString) 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.FileSystemObject")
      Set objOutputFile = objFSO.CreateTextFile("Results.csv", True)
      objOutputFile.Write "Computer;Log File;Date;Time;Event Type;User;Source;Category;Event ID;Doc Number;Doc Name;Owner;Printer;Port;Size;Pages"
      arrEvents = Split(strServerLog, "^|^")
      For intCount = LBound(arrEvents) To UBound(arrEvents)
            'MsgBox Join(Split(arrEvents(intCount), "^;^"), ";")
            objOutputFile.Write Join(Split(arrEvents(intCount), "^;^"), ";")
      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_Computer(byval strComputerName)

      Dim objWMIService, colLogFiles, objLogFile, intTotal, colItems, objItem, strCurrentTimeZone
      Const wbemFlagReturnImmediately = &h10
      Const wbemFlagForwardOnly = &h20

      Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
              strComputerName & "\root\cimv2")

      Set colItems = objWMIService.ExecQuery("Select 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_Computer = strCurrentTimeZone
      
End Function

Function Ping(strComputer)
      Dim objShell, boolCode
      Set objShell = CreateObject("WScript.Shell")
      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(strOriginalString, 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(intTotalLengthRequired, Left(strCharacterToPadWith, 1)) & strOriginalString, intTotalLengthRequired)
            Case "right"
                  Pad_String = Left(strOriginalString & String(intTotalLengthRequired, Left(strCharacterToPadWith, 1)), intTotalLengthRequired)
      End Select
End Function
'========

Regards,

Rob.
0
 
RobSampsonCommented:
LeeTutor, the code that I posted does work, by enumerating the event log on the print server, but I did find an error with the page number output.  This fixes that......

'======================
dteStartTime = DateAdd("d", -1, Now)
strResultsFile = "Results.csv"

strTimeBias = Get_CurrentTimeZone_Of_Computer(".")
strTimeBias = "+" & strTimeBias

strDateFrom = Year(dteStartTime) & Pad_String(Month(dteStartTime), 2, "Left", "0") & Pad_String(Day(dteStartTime), 2, "Left", "0") & "000000.000000" & strTimeBias
strDateTo = Year(dteStartTime) & Pad_String(Month(dteStartTime), 2, "Left", "0") & Pad_String(Day(dteStartTime), 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:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
      strServerTimeBias = Get_CurrentTimeZone_Of_Computer(strComputer)
      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.CategoryString) 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, Len(objEvent.Message) - (InStr(objEvent.Message, "; pages printed: ") + 18))
                              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.FileSystemObject")
      Set objOutputFile = objFSO.CreateTextFile(strResultsFile, True)
      objOutputFile.Write """Computer"",""Log File"",""Date"",""Time"",""Event Type"",""User"",""Source"",""Category"",""Event ID"",""Doc Number"",""Doc Name"",""Owner"",""Printer"",""Port"",""Size"",""Pages"""
      arrEvents = Split(strServerLog, "^|^")
      For intCount = LBound(arrEvents) To UBound(arrEvents)
            'MsgBox Join(Split(arrEvents(intCount), "^;^"), ";")
            objOutputFile.Write VbCrLf & """" & Join(Split(arrEvents(intCount), "^;^"), """,""") & """"
      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_Computer(byval strComputerName)

      Dim objWMIService, colLogFiles, objLogFile, intTotal, colItems, objItem, strCurrentTimeZone
      Const wbemFlagReturnImmediately = &h10
      Const wbemFlagForwardOnly = &h20

      Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
              strComputerName & "\root\cimv2")

      Set colItems = objWMIService.ExecQuery("Select 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_Computer = strCurrentTimeZone
      
End Function

Function Ping(strComputer)
      Dim objShell, boolCode
      Set objShell = CreateObject("WScript.Shell")
      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(strOriginalString, 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(intTotalLengthRequired, Left(strCharacterToPadWith, 1)) & strOriginalString, intTotalLengthRequired)
            Case "right"
                  Pad_String = Left(strOriginalString & String(intTotalLengthRequired, Left(strCharacterToPadWith, 1)), intTotalLengthRequired)
      End Select
End Function
'======================

Regards,

Rob.
0
 
RobSampsonCommented:
nenrico, does my solution help you with this problem at all?

Regards,

Rob.
0
 
Computer101Commented:
Forced accept.

Computer101
EE Admin
0

Featured Post

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Tackle projects and never again get stuck behind a technical roadblock.
Join Now