Title: Message
Yeah, I fought with that thing too.  Here is my function I use to pick a printer - PrinterName and print 2 copies for example.  If it works it should return an "OK" and if not some sort of error message. It assumes the VMagicPPII dialog box is open and returns an error if it isn't
 
I can't tell you exactly where theirs went wrong - one problem was it couldn't pick the last entry but there was also something about picking the one above or below - but this one works for me.  If something doesn't make sense, let me know.  If necessary, I could review my code vis-a-vis their code to be more specific how theirs didn't work.
 
Peter Turner
Fort HealthCare
(920) 568-5137
 
I call the SendToPrinter function with:
 
          tmpSendToPrinter = SendToPrinter(PrinterName,2)
          If InStr(UCase(tmpSendToPrinter), UCase("Error")) > 0 Then
            ' One could use
            ' MsgBox tmpSendToPrinter
           ' but I call
            WriteToLog tmpSendToPrinter, Trim(ScriptName) & ".log"
            Exit Sub
          End If

 
 
 
 
Function SendToPrinter(NewPrinterName As String, Optional Copies As Long)
On Error GoTo ScriptError
 
    Dim i As Long
    Dim Length As Long
    Dim Dif As Long
    Dim NewPrinterIndex As Long
    Dim CurrentPrinterIndex As Long
    Dim PickListLine As String
    Dim w As New WinScript
    Dim PrinterList()
    ReDim PrinterList(200)
    NewPrinterName = UCase(NewPrinterName) ' wouldn't want to depend on someone entering the name in the right case
    w.Wait 1
    If Copies < 1 Or Copies > 999 Then Copies = 1
    w.Connect "Print Destination", stWindows
    w.Click "Print
[EMAIL PROTECTED],72"  ' Select print as the output.
    i = 1
    Length = 30
    NewPrinterIndex = 0
    CurrentPrinterIndex = 0
    SendToPrinter = "OK"
    Do
        PickListLine = w.View(Window:="Print
[EMAIL PROTECTED],84", Row:=i, Col:=1, Length:=Length, B:=bcComboBoxAll)
        PickListLine = UCase(Left(PickListLine, InStr(PickListLine & vbCrLf, vbCrLf) - 1))
        PrinterList(i) = PickListLine
        If InStr(PickListLine, "-->") <> 0 Then
          CurrentPrinterIndex = i  ' index for the current printer
        End If
        If InStr(PickListLine, NewPrinterName) <> 0 Then
          NewPrinterIndex = i  ' index for the requested printer
        End If
        DoEvents
        If NewPrinterIndex > 0 And CurrentPrinterIndex > 0 Then  ' found the selected printer and the new request
          Exit Do
        End If
 
        i = i + 1
        If Len(Trim(PickListLine)) = 0 Then  ' If we are here we have not found the specified printer - post an error
          SendToPrinter = "Error: " & NewPrinterName & " printer is not installed."
          Exit Do
        End If
    Loop
     
    If InStr(UCase(SendToPrinter), UCase("Error")) > 0 Then
      Exit Function
    End If
    w.Click "Print
[EMAIL PROTECTED],84"
    Dif = CurrentPrinterIndex - NewPrinterIndex
    Select Case True
      Case Dif > 0
        'ShowProgress "Moving up " & Dif & " to " & NewPrinterName
        For i = 1 To Dif
            w.Key "{UP}"
        Next i
      Case Dif < 0
        Dif = 0 - Dif
        ' ShowProgress "Moving down " & Dif & " to " & NewPrinterName
        For i = 1 To Dif
            w.Key "{DOWN}"
        Next i
      Case Dif = 0
         'ShowProgress "Printer " & NewPrinterName & " was selected"
    End Select
    w.Wait 0.5
    w.Key "{TAB}"
    w.Wait 0.2
    If Copies > 1 Then
      ' ShowProgress "Printing " & Copies & " copies"
    Else
      ' ShowProgress "Printing " & Copies & " copy"
    End If
    w.Key Copies
    w.Key "{enter}"
    i = 1
    Do
      If InStr(UCase(w.View), UCase("OK")) > 0 Then
        w.Key "{enter}"
        Exit Do
      End If
      i = i + 1
      DoEvents
    Loop
    Set w = Nothing
Exit Function
ScriptError:
  Select Case True
    Case Err = seDoEvents
        DoEvents
        Resume
    Case Err = -2147463162
      MsgBox "SendToPrinter: Printer dialog box was not open when printer routine was called"
    Case Else
      MsgBox "SendToPrinter:" & Err & ": " & Error
      Exit Function
     '   If Err = seTimeOut Then End
     '   If Err = seHalt Then Exit Sub
  End Select
 
End Function
-----Original Message-----
From: [EMAIL PROTECTED] [mailto:[EMAIL PROTECTED] On Behalf Of [EMAIL PROTECTED]
Sent: Monday, August 09, 2004 8:41 AM
To: [EMAIL PROTECTED]
Subject: [Talk] Select Printer Script


Hi All,

I ahve been tryhing to get the SelectPrinter script from the BOSSOFT.com site to work correctly. So far it seem so pick the wrong printer, some times the one above, some times the one below. I am not trying for the first or last printer in the list, but there are about 20 printers to choose from.

Any ideas would be great.

Thanks

Sub SelectPrinter(ByVal Printer As String)
    Dim i As Integer
    Dim PrinterPos As Integer
    Dim SelectPos As Integer
    Dim t$
    Dim Dif As Integer
    Dim W As New WinScript

    Wait 1
   
    W.Connect "Print Destination", stWindows
    W.Activate "Print Destination"
    W.Click "Print [EMAIL PROTECTED],72"
    i = 1
    PrinterPos = 0
    SelectPos = 0

    While PrinterPos = 0 Or SelectPos = 0
        t$ = Trim(W.View(Window:="Print [EMAIL PROTECTED],84", Row:=i, col:=1, length:=30, b:=bcComboBoxAll))
        If InStr(t$, "-->") <> 0 Then SelectPos = i
        If InStr(t$, Printer) <> 0 Then PrinterPos = i
        DoEvents
        i = i + 1
   Wend
    W.Click "Print [EMAIL PROTECTED],84"
    Dif = SelectPos - PrinterPos
    If Dif > 0 Then
        For i = 1 To Dif
            W.Key "{UP}"
        Next i
    ElseIf Dif < 0 Then
        Dif = 0 - Dif
        For i = 1 To Dif
            W.Key "{DOWN}"
        Next i
    End If
    Wait 0.5
    W.Key "{TAB}"
End Sub

Bruce Krigman
Information Systems
South Shore Hospital
781-340-8299

Reply via email to