Dx21 - Script Library

Home

eZine

Coding

Software

Network Admin.

Home > Coding > Libraries > Script Library > View Item Info

	Back
	Scripting References

Batch Print

Facilitates batch printing of multiple files within XP from the Send To context menu fly out, thus avoiding the Windows XP bug when printing multiple documents from the Explorer (especially PDF files where the Move dialog is presented for each file).

Option Explicit

'////////////////////////////////////////////////////
'Batch Printing Utility
'File Name: PrintPDF.VBS
'Script Version: 1.0.0
'Last Edit: 4/5/2005
'Developer: Dx21, LLC
'////////////////////////////////////////////////////

Dim strArgs, strPrint, bDebug
Dim objShell, objArg

'Create Objects
Set objShell = CreateObject("WScript.Shell")

'Determine Arguments
If WScript.Arguments.Count = 0 Then ShowHelp
If WScript.Arguments.Named.Exists("?") Then ShowHelp
If WScript.Arguments.Named.Exists("i") Or WScript.Arguments.Named.Exists("I") Then Integration 1
If WScript.Arguments.Named.Exists("u") Or WScript.Arguments.Named.Exists("U") Then Integration 0
bDebug = True

'Print Documents
For Each objArg In WScript.Arguments.UnNamed
	strPrint = GetCMDLine(Right(objArg,Len(objArg)-InStrRev(objArg,".")+1))
	If strPrint <> "" And InStr(1, strPrint, "%1") > 0 Then
		If InStr(1, objArg, " ") > 0 Then objArg = Chr(34) & objArg & Chr(34)
		strPrint = Replace(strPrint, "%1", objArg)
		If bDebug Then
			WScript.Echo "Printing: " & objArg
			WScript.Echo "Cmd Line: " & strPrint
			WScript.Echo 
		End If
		objShell.Run strPrint, 1, False
	End If
Next

If bDebug Then MsgBox "Complete"

CleanEnv 0
'-------------------------------------------------------------------------
Sub CleanEnv(intExitCode)
	On Error Resume Next
	
	Set objShell = Nothing

WScript.Quit intExitCode
End Sub

Sub Integration(intAction)
	Dim objFSO, objLNK
	Dim strSendTo, intExit, strEXE
	
	Set objFSO = CreateObject("Scripting.FileSystemObject")
	strSendTo = GetData("HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders\SendTo", "")
	If strSendTo = "" Or objFSO.FolderExists(strSendTo) = False Then CleanEnv -99
	
	If intAction = 1 Then
		'Install		
		objFSO.CopyFile WScript.ScriptFullName, "C:\WINDOWS\SYSTEM32\" & WScript.ScriptName
				
		Set objLNK = objShell.CreateShortcut(strSendTo & "\Batch Print.lnk")
		objLNK.TargetPath = "CSCRIPT.EXE"
		objLNK.Arguments = "C:\WINDOWS\SYSTEM32\" & WScript.ScriptName
		objLNK.Description = "Batch Print Utility"
		objLNK.IconLocation = objShell.ExpandEnvironmentStrings("%WINDIR%") & "\EXPLORER.EXE,2"
		
		objLNK.Save
		
	Else
		'Uninstall
		
		If objFSO.FileExists(strSendTo & "\Batch Print.lnk") Then objFSO.DeleteFile strSendTo & "\Batch Print.lnk", True
		If objFSO.FileExists("C:\WINDOWS\SYSTEM32\" & WScript.ScriptName) Then objFSO.DeleteFile "C:\WINDOWS\SYSTEM32\" & WScript.ScriptName, True
		
	End If
	
	Set objFSO = Nothing
	CleanEnv intAction + 2
End Sub

Sub ShowHelp()
	Dim strHelp
	
	strHelp = "USAGE:" & vbCr & "PRINTPDF.EXE [[/?] [/I] [/U]] FileName [FileName] [...]" & vbCr & vbCr
	strHelp = strHelp & "/? - (Optional) Shows This Help" & vbCr
	strHelp = strHelp & "/I - (Optional) Installs Program" & vbCr
	strHelp = strHelp & "/U - (Optional) Uninstalls Program" & vbCr & vbCr
	strHelp = strHelp & "FileName [FileName] [...]" & vbCr
	strHelp = strHelp & "     Space delimitated list of files to print" 
	
	MsgBox strHelp, vbOkOnly+vbInformation, "Help"

CleanEnv 1
End Sub

Function GetCMDLine(strExt)
	Dim strRegData
	
	strRegData = GetData("HKCR\" & strExt & "\", "")
	If strRegData <> "" Then 
		strRegData = GetData("HKCR\" & strRegData & "\shell\print\command\", "")
	End If
	
	GetCMDLine = strRegData
End Function

Function GetData(strRegKey, vDefault)
	Dim vReturn, bClearObj
	
	If TypeName(objShell) <> "IWshShell3" Then
		Dim objShell
		Set objShell = CreateObject("WScript.Shell")
		bClearObj = True
	End If
	
	On Error Resume Next
	
	vReturn = objShell.RegRead(strRegKey)
	If Err.number <> 0 Then
		GetData = vDefault
		Err.Clear
	Else
		GetData = vReturn
	End If
	
	If bClearObj = True Then Set objShell = Nothing

On Error Resume Next
End Function

'////////////////////////////////////////////////////
'Copyright  2005 Dx21, LLC
'	a Washingtion Limited Liability Company
'	All Rights Reserved
'
'Use of this script is subject to the terms and conditions
'as listed in our public Copyright and Disclamer statments.
'Those statements must be agreed to prior to use of this
'script:
'
'http://www.dx21.com/COPYRIGHT.ASP
'http://www.dx21.com/DISCLAIMER.ASP
'////////////////////////////////////////////////////

Unless otherwise noted, this code is licensed according to the terms and conditions listed in our copyright notice.

Last Modification:
4/6/2005

	FAQs \| Terms Of Use \| Privacy Policy \| Contact Us
	Copyright © 1997 - 2010 Dx21, LLC. All rights reserved. Dx21, LLC a Washington Limited Liability Company Page Rendered at: 9/9/2010 12:21:22 PM for Unknown