1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
|
Sub GetPageCounts()
intLastRow = Cells(65536, "A").End(xlUp).Row
intLastCol = Cells(1, 256).End(xlToLeft).Column
intLastCol = 2
For intRow = 8 To intLastRow
For intCol = 2 To intLastCol
If Cells(intRow, 1).Value <> "Date" And Cells(intRow, 1).Value <> "" Then
If Trim(Cells(intRow, intCol).Value) = "" Then
strServer = Trim(Mid(Cells(2, intCol).Value, InStr(Cells(2, intCol).Value, ":") + 1))
strPrinter = Trim(Mid(Cells(3, intCol).Value, InStr(Cells(3, intCol).Value, ":") + 1))
dteDate = CDate(Cells(intRow, 1).Value)
intPages = Get_Pages_Printed(strServer, strPrinter, dteDate)
Cells(intRow, intCol).Value = intPages
End If
End If
Next
Next
End Sub
Function Get_Pages_Printed(ByVal strComputer As String, ByVal strPrinterIP As String, ByVal dteStartTime As Date)
strTimeBias = Get_CurrentTimeZone_Of_Computer(".")
If Left(strTimeBias, 1) <> "-" Then 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
'MsgBox "Getting print jobs from " & strComputer & " for " & strPrinterIP & " on " & dteStartTime
intTotalCount = 0
If Ping(strComputer) = True Then
Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
strServerTimeBias = Get_CurrentTimeZone_Of_Computer(strComputer)
If Left(strServerTimeBias, 1) <> "-" Then 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
strQuery = "SELECT * FROM Win32_NTLogEvent WHERE LogFile = '" & strLogName & _
"' AND EventType = 3 AND EventCode = 10 AND SourceName = 'Print' AND TimeWritten >= '" & _
strDateFrom & "' AND TimeWritten <= '" & strDateTo & "'"
'MsgBox strQuery
Set colLoggedEvents = objWMI.ExecQuery _
(strQuery, "WQL", wbemFlagReturnImmediately + wbemFlagForwardOnly)
On Error Resume Next
For Each objEvent In colLoggedEvents
If Err.Number = 0 Then
On Error GoTo 0
'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)
If Left(strPortName, 3) = "IP_" Then strPortName = Mid(strPortName, 4)
'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 & "^|^"
If strPortName = strPrinterIP Then intTotalCount = intTotalCount + CInt(strPagesPrinted)
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
Get_Pages_Printed = intTotalCount
End Function
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
|
