http://dieseyer.de • all rights reserved • © 2011 v11.4

'v3.C***********************************************************
' File: TXTzumDrucker.VBS
' Autor: dieseyer@gmx.de
' dieseyer.de
'
' Kopiert eine Datei direkt zum Drucker. Es wird jedes!!!
' Zeichen der Datei zum Drucker geschickt. Man sollte also
' nur .PRN- oder ASCII-Dateien (z.B. Quelltexte) verwenden.
'
' Es gibt Scanner, mit denen es möglich ist, den Scanner,
' zusammen mit am PC angeschlossenen Drucker, als Kopierer
' zu nutzen. Auf dem PC ist zum Standarddrucker ein wei-
' terer gleicher Drucker zu installieren, der in eine
' Datei druckt. Nutzt man jetzt die Kopierer-Funktion,
' entsteht eine Datei (mit der Endung .PRN).
'
' Ich habe das mal verwendet, um die zahlreichen Kopien
' für meine Bewerbungen mit einem Laserdrucker zu drucken.
'
' 1b 45 = 27 69 = <Esc> E = PCL-DruckerReset / Seitenvorschub
' siehe Zeile 80: FSO.CopyFile TmpDatei, Drucker
'***************************************************************

Option Explicit

Dim WSHShell, FSO, WSHNet, NetPrn, oArgs
Dim FileOut, Text, Drucker, DruckerNr, Datei, TmpDatei, i

Set WSHShell = WScript.CreateObject("WScript.Shell")
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WSHNet = WScript.CreateObject("WScript.Network")
Set NetPRN = WSHNet.EnumPrinterConnections

set oArgs = Wscript.Arguments ' Argumente bereit stellen

If not oArgs.Count > 0 Then ' gibt es Argumente?
Text = "Das Ganze funktioniert so:" & vbCRLF & vbCRLF
Text = Text & "Mit der Maus Datei(en) auf das Skript ziehen und" & vbCRLF
Text = Text & "fallen lassen . . . dann wird's was!" & vbCRLF & vbCRLF
Text = Text & "Wenn es sich nicht um TXT- oder PRN- Dateien handelt," & vbCRLF
Text = Text & "können es HUNDERTE ! Seiten werden!" & vbCRLF
MsgBox Text, , WScript.ScriptName
WScript.Quit
End If

If Drucker = "" then Drucker = Druckerauswahl ' Function Aufruf
' ~~~~~~~~~~~~~~~~~~~~~~~

TmpDatei = WScript.ScriptFullName & ".Tmp"

Set FileOut = fso.OpenTextFile (TmpDatei, 2, true)
FileOut.WriteLine (Chr(27) & "E") ' Datei mit Seitenvorschub-Zeichenkette erstellen
FileOut.Close
Set FileOut = nothing
' if fso.FileExists (TmpDatei) then MsgBox WScript.ScriptName & ".Tmp"

Datei = ""
For i = 0 to oArgs.Count - 1 ' hole alle Argumente
Datei = Datei & " " & oArgs.item(i) & vbCRLF ' Protokoll
FSO.CopyFile oArgs.item(i), Drucker ' Datei zum Drucker kopieren
if fso.FileExists (TmpDatei) then
' nächste Zeile nur wenn erforderlich freigeben
' FSO.CopyFile TmpDatei, Drucker ' Datei mit Seitenvorschub-Zeichenkette zum Drucker kopieren
End If
Next

' if fso.FileExists (TmpDatei) then MsgBox "fso.FileDelete (" & TmpDatei & ")"
if fso.FileExists (TmpDatei) then fso.DeleteFile (TmpDatei)

Text = Datei & "wurde(n) zum Drucker an " & Drucker & " kopiert!" & vbCRLF & vbCRLF
Text = Text & "Möglicherweise muss von Hand der Seitenvorschub ausgelöst werden!"

WSHShell.Popup Text, 15, WScript.ScriptName



'***************************************************************
Function Druckerauswahl ' Anfanfg
'***************************************************************
' Es kann nur auf LPT? und Netzwerkdrucker kopiert werden

Dim i, n, Text, DruckerNr, NetPRN, WSHNet

Set WSHNet = WScript.CreateObject("WScript.Network")
Set NetPRN = WSHNet.EnumPrinterConnections

n = 0

' welche Drucker sind verwendbar:
For i = 0 To NetPRN.Count-1 Step 2
if Left(NetPRN(i+1),2) = "\\" then
n = n + 1
Text = Text & n & ": " & NetPRN(i) & vbTab & NetPRN(i+1) & vbCRLF
End If
if not Left(NetPRN(i+1),2) = "\\" then
if UCase(Left(NetPRN(i), 3)) = "LPT" then
n = n + 1
Text = Text & n & ": " & NetPRN(i) & vbTab & NetPRN(i+1) & vbCRLF
End If
End If
Next
Text = Text & vbCRLF & "Auf welchen Drucker soll gedruckt werden?"

DruckerNr = InputBox (Text, WScript.ScriptName)
On Error Resume Next
DruckerNr = Asc( DruckerNr ) -48
On Error GoTo 0

If DruckerNr > n OR DruckerNr < 1 then
Text = "!!! FALSCHE EINGABE !!!" & vbCRLF & vbCRLF & Text
DruckerNr = InputBox (Text, WScript.ScriptName)
On Error Resume Next
DruckerNr = Asc( DruckerNr ) -48
On Error GoTo 0
End If

If DruckerNr > n OR DruckerNr < 1 then DruckerNr = ""
If DruckerNr = "" then WSHShell.Popup " . . . denn eben nicht!", 10, WScript.ScriptName & " . . . ist zu Ende!" , 64
If DruckerNr = "" then WScript.Quit

n = 0

' gewählten Drucker ermitteln
For i = 0 To NetPRN.Count-1 Step 2
if Left(NetPRN(i+1),2) = "\\" then
n = n + 1
If n = DruckerNr Then Druckerauswahl = NetPRN(i+1)
End If
if not Left(NetPRN(i+1),2) = "\\" then
if UCase(Left(NetPRN(i), 3)) = "LPT" then
n = n + 1
If n = DruckerNr Then Druckerauswahl = NetPRN(i )
End If
End If
Next

End Function ' Druckerauswahl
'***************************************************************


http://dieseyer.de • all rights reserved • © 2011 v11.4