Sample Code - Print by Location by Job Size
I thought some might like to see this. We ha ve a rather large office with workgroup printers and copiers spread throughout. In order to leverage cost savings we have setup different page count thresholds that will trigger printing to the copiers based on job type. We wanted the jobs to go to the nearest printers relative to the user and send them an email telling them where their job was printed.
So here it is:
It requires that the PD service is running under a user account that can access AD. In addition, your users must have location information recorded in AD. All printer drivers must be using PS. And you must have the "SMTPsvg.Mailer" component installed on your print server (for my implentantion anyway) firewalls, SMTP whitelists etc,etc,etc setup so that the users receive their email.
Create a Virtual Printer and just put the following code in a script event (for different attribute combinations create mulitple VP's and change the code to filter on what you want to) :
<begin script>
'Port Defaults
LetterHeadRequired = False
ColorRequired = False
ChecksRequired = False
'Get Active Directory instance of user that printed document
Set objTrans = CreateObject("NameTranslate")
objTrans.Init 1, "[NETBIOSDOMAIN]"
objTrans.Set 3, "[NETBIOSDOMAIN]" & "\" & UserName
strUserDN = objTrans.Get(1)
Set objUser = GetObject("LDAP://" & strUserDN)
'Gather information about the user
FullName = objUser.displayName
EmailAddress = objUser.mail
PrintZone = objUser.get("physicalDeliveryOfficeName")
PrintZone = Replace(PrintZone, "Zone","")
PrintZone = Trim(PrintZone)
PrinterSpooledTime = FormatDateTime(Now, 0)
PrinterName = ""
'Figure out the printer and print the job
Set objPrinters = LoadRsFromXML("C:\Users\Public\Documents\Printing\PrinterDatabase.xml")
objPrinters.Filter = "Zone = '" & PrintZone & "'"
objPrinters.Sort = "MaxThreshold ASC"
Do While Not objPrinters.EOF
If TotalPages <= objPrinters("MaxThreshold") Then
If ColorRequired Then
PrinterMatch = objPrinters("Color")
Else
PrinterMatch = True
End If
If LetterheadRequired Then
PrinterMatch = PrinterMatch And objPrinters("Letterhead")
Else
PrinterMatch = PrinterMatch And True
End If
If ChecksRequired Then
PrinterMatch = PrinterMatch And objPrinters("Checks")
Else
PrinterMatch = PrinterMatch And True
End If
If PrinterMatch Then
PrinterName = objPrinters("PrinterName")
RePrint PrintFilePath, PrinterName, DocumentName
Exit Do
End If
End If
objPrinters.MoveNext
Loop
objPrinters.Close
If PrinterName = "" Then
EmailSubject = "PRINT FAILURE: No matching printer defined"
EmailBody = DocumentName & " spooled at " & Date & " was unable to print because a matching printer " & _
"was unable to be located. Please forward this email to Help for assistance." & vbCrLf & vbCrLf & _
" Username: " & UserName & vbCrLf & _
" Zone: " & PrinterZone
Else
EmailSubject = "PRINT SUCCESS: Output on " & PrinterName
EmailBody = DocumentName & " spooled at " & PrinterSpooledTime & " was successfully printed on " & PrinterName
End If
Set objEmail = CreateObject("SMTPsvg.Mailer")
objEmail.RemoteHost = "mail.emaildomain.com"
objEmail.FromName = "Company Printing Subsystem"
objEmail.FromAddress = "AgentIT@emaildomain.com"
objEmail.AddRecipient FullName, EmailAddress
objEmail.Subject = EmailSubject
objEmail.ContentType = "text/html"
objEmail.BodyText = EmailBody
objEmail.SendMail
Public Function LoadRsFromXML(FullPath)
On Error Resume Next
Set oRs = CreateObject("ADODB.Recordset")
oRs.CursorLocation = 3
oRs.Open FullPath, "Provider=MSPersist;", 0, 1, 256 'adOpenForwardOnly, adLockReadOnly, adCmdFile
If Err.Number = 0 Then
Set LoadRsFromXML = oRs
End If
End Function
<end script>
In addition you also need an xml file that contains your printers, thresholds, location, and any other attributes you care about. Mine is listed below as an example:
<begin file>
<xml xmlns:s="uuid:BDC6E3F0-6DA3-11d1-A2A3-00AA00C14882" xmlns:dt="uuid:C2F41010-65B3-11d1-A29F-00AA00C14882" xmlns:rs="urn:schemas-microsoft-com:rowset" xmlns:z="#RowsetSchema">
<s:Schema id="RowsetSchema">
<s:ElementType name="row" content="eltOnly">
<s:AttributeType name="ID" rs:number="1" rs:maydefer="true" rs:writeunknown="true">
<s:datatype dt:type="int" dt:maxLength="4" rs:precision="10" rs:fixedlength="true"/>
</s:AttributeType>
<s:AttributeType name="Zone" rs:number="2" rs:nullable="true" rs:maydefer="true" rs:writeunknown="true">
<s:datatype dt:type="string" dt:maxLength="255"/>
</s:AttributeType>
<s:AttributeType name="PrinterName" rs:number="3" rs:nullable="true" rs:maydefer="true" rs:writeunknown="true">
<s:datatype dt:type="string" dt:maxLength="255"/>
</s:AttributeType>
<s:AttributeType name="MaxThreshold" rs:number="4" rs:nullable="true" rs:maydefer="true" rs:writeunknown="true">
<s:datatype dt:type="int" dt:maxLength="4" rs:precision="10" rs:fixedlength="true"/>
</s:AttributeType>
<s:AttributeType name="Color" rs:number="5" rs:maydefer="true" rs:writeunknown="true">
<s:datatype dt:type="boolean" dt:maxLength="2" rs:fixedlength="true"/>
</s:AttributeType>
<s:AttributeType name="Letterhead" rs:number="6" rs:maydefer="true" rs:writeunknown="true">
<s:datatype dt:type="boolean" dt:maxLength="2" rs:fixedlength="true"/>
</s:AttributeType>
<s:AttributeType name="Checks" rs:number="7" rs:maydefer="true" rs:writeunknown="true">
<s:datatype dt:type="boolean" dt:maxLength="2" rs:fixedlength="true"/>
</s:AttributeType>
<s:extends type="rs:rowbase"/>
</s:ElementType>
</s:Schema>
<rs:data>
<z:row ID="1" Zone="D" PrinterName="HPLJ4350_11" MaxThreshold="10" Color="False" Letterhead="False" Checks="False"/>
<z:row ID="2" Zone="D" PrinterName="KMCL550_01" MaxThreshold="100000" Color="True" Letterhead="True" Checks="False"/>
<z:row ID="3" Zone="D" PrinterName="HPLJ4350_05" MaxThreshold="10" Color="False" Letterhead="False" Checks="False"/>
<z:row ID="4" Zone="D" PrinterName="HPCL3700_01" MaxThreshold="10" Color="True" Letterhead="False" Checks="False"/>
<z:row ID="5" Zone="D" PrinterName="HPLJ4200_02" MaxThreshold="10" Color="False" Letterhead="True" Checks="False"/>
</rs:data>
</xml>
<end file>
We have 80 users and this works well once you have it all setup and running.
24th Jul 2008