Listing 1: PrinterInfo.vbs, cont.
' Begin Callout G
If fso.FileExists(NewestPrnList) Then
If fso.FileExists(PreviousPrnList) Then
fso.MoveFile PreviousPrnList,ArchivePrnList
End If
fso.MoveFile NewestPrnList,PreviousPrnList
End If
' End Callout G
' Begin Callout H
'Find New
If fso.FileExists(PreviousPrnList) Then
Set DRS2 = CreateObject("ADOR.Recordset")
DRS2.Open PreviousPrnList
Row = Row + 1
CloseDRS2 = True
If DRS.RecordCount > 0 Then
DRS.MoveFirst
Do while Not DRS.EOF
sn = DRS.Fields.Item("PrintShare")
If DRS2.RecordCount > 0 Then
DRS2.MoveFirst
End If
DRS2.Find("PrintShare = '" & Replace(sn,"'","'") & "'")
If DRS2.EOF Then
XL.Cells(Row,Col).Value = sn : Col = Col + 1
XL.Cells(Row,Col).Value = "Possibly New" : Col = Col + 1
XL.Cells(Row,Col).Value = "Not in Previous List"
: Row = Row + 1 : Col = 1
End If
DRS.MoveNext
Loop
End If
'Find Removed
If DRS.RecordCount > 0 Then
DRS.MoveFirst
End If
If DRS2.RecordCount > 0 Then
DRS2.MoveFirst
End If
Do while Not DRS2.EOF
sn = DRS2.Fields.Item("PrintShare")
If DRS.RecordCount > 0 Then
DRS.MoveFirst
End If
DRS.Find("PrintShare = '" & Replace(sn,"'","'") & "'")
If DRS.EOF Then
XL.Cells(Row,Col).Value = sn
: Col = Col + 1
XL.Cells(Row,Col).Value = "Possibly Deleted."
: Col = Col + 1
XL.Cells(Row,Col).Value = "In Previous List but
not in Most Recent List" : Row = Row + 1 : Col = 1
End If
DRS2.MoveNext
Loop
'Changes
If DRS.RecordCount > 0 Then
DRS.MoveFirst
End If
If DRS2.RecordCount > 0 Then
DRS2.MoveFirst
End If
Do while Not DRS.EOF
sn = DRS.Fields.Item("PrintShare")
If DRS2.RecordCount > 0 Then
DRS2.MoveFirst
End If
DRS2.Find("PrintShare = '" & Replace(sn,"'","'") & "'")
If Not DRS2.EOF Then
'compare significant fields
New1 = DRS.Fields.Item("PortName")
New2 = DRS.Fields.Item("DriverName")
New3 = DRS.Fields.Item("PrinterName")
New4 = DRS.Fields.Item("Location")
New5 = DRS.Fields.Item("Comment")
New6 = DRS.Fields.Item("PrintProcessor")
New7 = DRS.Fields.Item("BiDirectionalEnabled")
Old1 = DRS2.Fields.Item("PortName")
Old2 = DRS2.Fields.Item("DriverName")
Old3 = DRS2.Fields.Item("PrinterName")
Old4 = DRS2.Fields.Item("Location")
Old5 = DRS2.Fields.Item("Comment")
Old6 = DRS2.Fields.Item("PrintProcessor")
Old7 = DRS2.Fields.Item("BiDirectionalEnabled")
If (New1 <> Old1) OR (New2 <> Old2) OR (New3 <> Old3) OR (New4 <> Old4) OR _
(New5 <> Old5) OR (New6 <> Old6) OR (New7 <> Old7) Then
Col = 1
XL.Cells(Row,Col).Value = "Changed" : Col = Col + 1
XL.Cells(Row,Col).Value = "PortName" : Col = Col + 1
XL.Cells(Row,Col).Value = "DriverName" : Col = Col + 1
XL.Cells(Row,Col).Value = "PrinterName" : Col = Col + 1
XL.Cells(Row,Col).Value = "Location" : Col = Col + 1
XL.Cells(Row,Col).Value = "Comment" : Col = Col + 1
XL.Cells(Row,Col).Value = "PrintProcessor" : Col = Col + 1
XL.Cells(Row,Col).Value = "BiDirectionalEnabled" : Row = Row + 1 : Col = 1
XL.Cells(Row,Col).Value = sn : Col = Col + 1
XL.Cells(Row,Col).Value = New1 : Col = Col + 1
XL.Cells(Row,Col).Value = New2 : Col = Col + 1
XL.Cells(Row,Col).Value = New3 : Col = Col + 1
XL.Cells(Row,Col).Value = New4 : Col = Col + 1
XL.Cells(Row,Col).Value = New5 : Col = Col + 1
XL.Cells(Row,Col).Value = New6 : Col = Col + 1
XL.Cells(Row,Col).Value = New7 : Row = Row + 1 : Col = 1
XL.Cells(Row,Col).Value = sn : Col = Col + 1
XL.Cells(Row,Col).Value = old1 : Col = Col + 1
XL.Cells(Row,Col).Value = old2 : Col = Col + 1
XL.Cells(Row,Col).Value = old3 : Col = Col + 1
XL.Cells(Row,Col).Value = old4 : Col = Col + 1
XL.Cells(Row,Col).Value = old5 : Col = Col + 1
XL.Cells(Row,Col).Value = old6 : Col = Col + 1
XL.Cells(Row,Col).Value = old7 : Col = Col + 1 : Row = Row + 1
End If
End If
DRS.MoveNext
Loop
End If
' End Callout H
XL.Cells.EntireColumn.AutoFit
XL.Range("A1").Select
' Begin Callout I
Const adPersistXML = 1
DRS.Save NewestPrnList,adPersistXML
DRS.Close
' End Callout I
If CloseDRS2 Then
DRS2.Close
End If
XL.Visible = TRUE
Set XL = nothing
strMessage = "Done"
strScriptName = "Get Printer Info"
CreateObject("WScript.Shell").Popup strMessage,2,strScriptName,vbInformation
Sub WriteErr
On Error Resume Next
XL.Sheets("Errors").Select
XL.Cells(ErrRow,ErrCol).Value = "\\" & objPrinter.SystemName &
"\" & objPrinter.ShareName : ErrCol = ErrCol + 1
XL.Cells(ErrRow,ErrCol).Value = DetErr(objPrinter.DetectedErrorState)
: ErrCol = ErrCol + 1
XL.Cells(ErrRow,ErrCol).Value = objPrinter.Status : ErrCol = ErrCol + 1
XL.Cells(ErrRow,ErrCol).Value = objPrinter.PortName : ErrCol = ErrCol + 1
XL.Cells(ErrRow,ErrCol).Value = objPrinter.DriverName : ErrCol = ErrCol + 1
XL.Cells(ErrRow,ErrCol).Value = objPrinter.Location : ErrCol = ErrCol + 1
XL.Cells(ErrRow,ErrCol).Value = objPrinter.Comment : ErrCol = ErrCol + 1
XL.Cells(ErrRow,ErrCol).Value = objprinter.PrinterState & " " &
PrnState(objprinter.PrinterState) : ErrCol = ErrCol + 1
ErrRow = ErrRow + 1 : ErrCol = 1
XL.Cells.EntireColumn.AutoFit
XL.Sheets(PS).Select
End Sub
Function PrnState(pstate)
Select Case pstate
Case "0" CurState = "Online"
Case "1" CurState = "Paused"
Case "2" CurState = "Pending Deletion"
Case "3" CurState = "Error"
Case "4" CurState = "Paper Jam"
Case "5" CurState = "Paper Out"
Case "6" CurState = "Manual Feed"
Case "7" CurState = "Paper Problem"
Case "8" CurState = "Offline"
Case "16" CurState = "No Paper"
Case "128" CurState = "Offline"
Case "256" CurState = "IO Active"
Case "512" CurState = "Busy"
Case "1024" CurState = "Printing"
Case "1028" CurState = "Disconnected-Offline"
Case "1034" CurState = "Jammed"
Case "1042" CurState = "Add Media"
Case "2048" CurState = "Output Bin Full"
Case "4096" CurState = "Not Available"
Case "8192" CurState = "Waiting"
Case "6384" CurState = "Processing"
Case "32768" CurState = "Initializing"
Case "65536" CurState = "Warming Up"
Case "131072" CurState = "Toner Low"
Case "262144" CurState = "No Toner"
Case "524288" CurState = "Page Punt"
Case "263170" CurState = "OutPut Bin Full"
Case "1048576" CurState = "User Intervention"
Case "2097152" CurState = "Out of Memory"
Case "4194304" CurState = "Door Open"
Case "8388608" CurState = "Server Unknown"
Case "16777216" CurState = "Power Save"
End Select
PrnState = CurState
End Function
Function ZeroDate(dDate)
'*** convert dates like 7/7/2008 to 07/07/2008
'*** These are used in the Archive filenames and this
'*** allows them to be sorted properly when displayed
'*** in PrinterInfoCompare.HTA
If Instr(1,Left(dDate,2),"/") <> 0 Then
dDate = "0" & dDate
End If
For k = 1 to 9
dDate = Replace(dDate,"/" & k & "/","/0" & k & "/")
Next
ZeroDate = dDate
End Function
Function MilitaryTime(dDate)
'*****************************************************
'*** Convert time portion of DateTime to Military Time
'*** ex. 12/19/2008 1:07:54 PM would be converted
'*** to 12/19/2008 1307:54
'*****************************************************
DTarray = Split(dDate," ")
timestr = DTarray(1)
tarray = Split(timestr,":")
Select Case DTarray(2) = "PM"
Case True
If tarray(0) < 12 Then
Milhr = tarray(0) + 12
Else
Milhr = tarray(0)
End If
Case False
If tarray(0) < 10 Then
Milhr = "0" & tarray(0)
ElseIf tarray(0) = 12 Then
Milhr = "00"
Else
Milhr = tarray(0)
End If
End Select
MilitaryTime = DTarray(0) & " " & Milhr & tarray(1) & ":" & tarray(2)
End Function