'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  

'***************************************************************