HP Printer Page Count Problem

[dpbarry]

Hi Folks..

I have an excel document that is supposed to ping the list of printer I have and return the total page count but I have run into a problem.

It partly works and I can't work out why.

When I run the macro, For some reason, the ping function doesn't seem to work. It tells me the printer did not respond to ping BUT, when you click on okay, it returns the total page count of the printer. I've verified the page count by going directly to the printer status page.

If I open a command prompt, I can ping the printer IP adress okay.

Can anyone shed any light on this for me. I've changed the colour of the ping function to red below for ease of identification cus I can't attach files.

The main document has 5 headings and as you can see I get 'Total Pages Printed values but have to click okay after each printer is ping to confirm that it could be pinged.

Weird

<TABLE style="WIDTH: 478pt; BORDER-COLLAPSE: collapse" cellSpacing=0 cellPadding=0 width=635 border=0 x:str><COLGROUP><COL style="WIDTH: 80pt; mso-width-source: userset; mso-width-alt: 3913" width=107><COL style="WIDTH: 62pt; mso-width-source: userset; mso-width-alt: 2998" span=3 width=82><COL style="WIDTH: 67pt; mso-width-source: userset; mso-width-alt: 3254" width=89><COL style="WIDTH: 145pt; mso-width-source: userset; mso-width-alt: 7058" width=193><TBODY><TR style="HEIGHT: 25.5pt" height=34><TD class=xl23 style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; WIDTH: 80pt; BORDER-BOTTOM: #ece9d8; HEIGHT: 25.5pt; BACKGROUND-COLOR: transparent" width=107 height=34>Print Server
Name

</TD><TD class=xl23 style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; WIDTH: 62pt; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" width=82>Printer IP
Address

</TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; WIDTH: 62pt; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" width=82>Start Date</TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; WIDTH: 62pt; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" width=82>End Date</TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; WIDTH: 67pt; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" width=89>Pages Printed </TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; WIDTH: 145pt; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" width=193>Total Pages Printed (Real Time)</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; HEIGHT: 12.75pt; BACKGROUND-COLOR: transparent" height=17>HP4200-M001</TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent">10.127.33.129</TD><TD class=xl22 style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" align=right x:num="39856">12-Feb-09</TD><TD class=xl22 style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" align=right x:num="40221">12-Feb-10</TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent"></TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" align=right x:num>74095</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; HEIGHT: 12.75pt; BACKGROUND-COLOR: transparent" height=17>HP4200-M002</TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent">10.127.33.130</TD><TD class=xl22 style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" align=right x:num="39856">12-Feb-09</TD><TD class=xl22 style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" align=right x:num="40221">12-Feb-10</TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent"></TD><TD class=xl23 style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; WIDTH: 145pt; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" align=right width=193 x:num>81003</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; HEIGHT: 12.75pt; BACKGROUND-COLOR: transparent" height=17>HP4200-M003</TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent">10.127.33.131</TD><TD class=xl22 style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" align=right x:num="39856">12-Feb-09</TD><TD class=xl22 style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" align=right x:num="40221">12-Feb-10</TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent"></TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" align=right x:num>76189</TD></TR></TBODY></TABLE>

Declan

The code is as follows:

Sub Check_Printer()
'Get_Printer_Page_Counts_Between_Dates.xls

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

'intRow = 2
intCol = 1

For intRow = 2 To Cells(65536, 1).End(xlUp).Row
strPagesPrinted = 0
strTotalPages = 0
strOverallPages = 0

strComputer = Cells(intRow, intCol)
strPrinterPort = Cells(intRow, intCol + 1)
dteStartTime = CDate(Cells(intRow, intCol + 2))
dteEndTime = CDate(Cells(intRow, intCol + 3))
strDateFrom = Year(dteStartTime) & Pad_String(Month(dteStartTime), 2, "Left", "0") & Pad_String(Day(dteStartTime), 2, "Left", "0") & "000000.000000" & strTimeBias
strDateTo = Year(dteEndTime) & Pad_String(Month(dteEndTime), 2, "Left", "0") & Pad_String(Day(dteEndTime), 2, "Left", "0") & "235959.000000" & strTimeBias

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
strPortName = Mid(objEvent.Message, InStr(objEvent.Message, " via port ") + 10, InStr(objEvent.Message, ". Size in bytes: ") - InStr(objEvent.Message, " via port ") - 10)
If Right(strPortName, Len(strPrinterPort)) = strPrinterPort Then
strPagesPrinted = Mid(objEvent.Message, InStr(objEvent.Message, "; pages printed: ") + 17, Len(objEvent.Message) - (InStr(objEvent.Message, "; pages printed: ") + 18))
strTotalPages = strTotalPages + strPagesPrinted
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
Cells(intRow, intCol + 4).Value = strTotalPages
Else
MsgBox strComputer & " did not respond to ping."
End If

If Ping(Replace(strPrinterPort, "IP_", "")) = True Then

arrPages = Array( _
"http://" & Replace(strPrinterPort, "IP_", "") & "/hp/device/info_configuration.html;Total Pages Printed:", _
"http://" & Replace(strPrinterPort, "IP_", "") & "/hp/device/this.LCDispatcher?dispatch=html&cat=0&pos=4;Total Printer Usage", _
"http://" & Replace(strPrinterPort, "IP_", "") & "/eng/main.htm;Total Page Count", _
"http://" & Replace(strPrinterPort, "IP_", "") & "/index_info.htm;Page Count", _
"http://" & Replace(strPrinterPort, "IP_", "") & "/ews/prtmaint/prtvolume.htm;Printer Page Count", _
"http://" & Replace(strPrinterPort, "IP_", "") & "/printer/maininfo.html;Page Count" _
)

For Each strPageInfo In arrPages
strURL = Split(strPageInfo, ";")(0)
strCounterText = Split(strPageInfo, ";")(1)
Set objHTTP = CreateObject("MSXML2.XMLHTTP")
objHTTP.Open "GET", strURL, False
objHTTP.Send

strPageText = objHTTP.responseText
If InStr(LCase(strPageText), LCase(Replace(strCounterText, " ", " "))) > 0 Then
strCounterText = Replace(strCounterText, " ", " ")
End If
If InStr(strPageText, """" & strCounterText & """;") > 0 Then
intPagesPos = InStr(strPageText, """" & strCounterText & """;") + 1 + Len(strCounterText) + 2
strCellText = Mid(strPageText, intPagesPos, InStr(Mid(strPageText, intPagesPos), ";") - 1)
strCellText = Replace(Replace(Replace(strCellText, vbCrLf, ""), vbCr, ""), vbLf, "")
strCellText = Mid(strCellText, InStrRev(strCellText, " ") + 1)
If IsNumeric(strCellText) = False Then
strOverallPages = Mid(strCellText, 2, Len(strCellText) - 2)
Else
strOverallPages = strCellText
End If
Else
intPagesPos = InStr(LCase(strPageText), LCase(strCounterText))
If intPagesPos > 0 Then

intNumberCellStart = InStrRev(LCase(strPageText), "<TR", p intPagesPos)<> intNumberCellEnd = InStr(intNumberCellStart, LCase(strPageText), "</TR>") + 5
strCellText = Mid(strPageText, intNumberCellStart, intNumberCellEnd - intNumberCellStart)
strCellText = Replace(Replace(Replace(strCellText, vbCrLf, ""), vbCr, ""), vbLf, "")
arrCellBits = Split(strCellText, ">")
For Each strCellBit In arrCellBits
If Left(Trim(strCellBit), 1) <> "<" And Len(Trim(strCellBit)) > 0 Then
strOverallPages = Trim(Left(Trim(strCellBit), InStr(Trim(strCellBit), "<") - 1))
End If
Next
End If
End If
If strOverallPages > 0 Then Exit For
Next

Set objHTTP = Nothing
Cells(intRow, intCol + 5).Value = strOverallPages
End If

Next

MsgBox "Done."
End Sub
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

 

[dpbarry]

Hi Mod..

Sorry.. Could you delete this message. I made a hash of it so I'll try it again becasue I need to trim down the length.

Regards

Declan