_________________________
Professionelle Entwicklerkomponenten
www.tools4vb.de

' Prototypisierung der API-Funktion DeviceCapabilities
Private Declare Function DeviceCapabilities _
  Lib "winspool.drv" Alias "DeviceCapabilitiesA" ( _
  ByVal lpDeviceName As String, _
  ByVal lpPort As String, _
  ByVal iIndex As Long, _
  ByRef lpOutput As Any, _
  ByVal dev As Long _
  ) As Long
' Konstante für den Parameter iIndex
Private Const DC_BINS As Long = 6&
Private Const DC_BINNAMES As Long = 12&
 
Private Sub ListPaperBins()
Dim PaperBins() As String
Dim lBinCount As Long
Dim lBinNumbers() As Integer
Dim sBinNames As String
Dim lNullPos As Long
Dim i As Long
  With Printer
    ' Anzahl unterstützter Papierschächte ermitteln:
    lBinCount = DeviceCapabilities(.devicename, .port, _
                DC_BINS, ByVal vbNullString, 0)
    ' Speicherplatz für die Rückgaben reservieren
    ReDim lBinNumbers(1 To lBinCount)
    sBinNames = Space$(24 * lBinCount)
    ' Nummern vorhandener Papierschächte abholen:
    DeviceCapabilities .devicename, .port, DC_BINS, lBinNumbers(1), 0
    ' Namen der vorhandenen Papierschächte abholen:
    DeviceCapabilities .devicename, .port, DC_BINNAMES, ByVal sBinNames, 0
  End With
  ' Schachtnummern und -namen extrahieren
  ' und im zweidimensionalen Array PaperBins ablegen:
  ReDim PaperBins(0 To lBinCount - 1, 0 To 1)
  For i = 1 To lBinCount
    ' Schachtnummer:
    PaperBins(i - 1, 0) = lBinNumbers(i)
    ' Schachtname:
    PaperBins(i - 1, 1) = Mid$(sBinNames, 24 * (i - 1) + 1, 24)
    ' Im Bedarfsfall das Stringende kürzen:
    lNullPos = InStr(PaperBins(i - 1, 1), vbNullChar)
    If lNullPos > 0 Then
      PaperBins(i - 1, 1) = Left$(PaperBins(i - 1, 1), lNullPos - 1)
    End If
  Next i
  ' Die gefundenen Daten in das Direktfenster ausgeben:
  Debug.Print "Vorhandene Papierschächte des Druckers " _
              & Printer.devicename & " am Anschluss " _
              & Printer.port & " :"
  For i = LBound(PaperBins) To UBound(PaperBins)
    Debug.Print PaperBins(i, 0) & ": " & PaperBins(i, 1)
  Next i
End Sub

Sub DruckerauswahlAM()
'
' Druckerauswahl Makro
'
Dim strDrucker As String
 
 
Rem ####################### Zuweisen der Variablen den Druckerinternen Fach-Ids _
  #########
Fach2 = 3
Fach3 = 2
 
Application.ActivePrinter = "\\einServer\einDrucker"
Application.PrintOut FileName:="", Range:=wdPrintAllDocument, Item:= _
        wdPrintDocumentContent, Copies:=1, Pages:="", _
        PageType:=wdPrintAllPages, _
        ManualDuplexPrint:=False, Collate:=True, Background:=True, _
        PrintToFile:= _
        False, PrintZoomColumn:=0, PrintZoomRow:=0, PrintZoomPaperWidth:=0, _
        PrintZoomPaperHeight:=0
ActiveDocument.PageSetup.FirstPageTray = Fach2
ActiveDocument.PageSetup.OtherPagesTray = Fach2
       stellt die Einstellungen des Druckers zurück
        ActivePrinter = strDrucker
        With ActiveDocument.PageSetup
           .FirstPageTray = wdPrinterAutomaticSheetFeed
          .OtherPagesTray = wdPrinterAutomaticSheetFeed
        End With
ActiveDocument.PrintOut
 
End Sub

Sub DruckerauswahlAM()
'
 
Application.ActivePrinter = "\\einServer\einDrucker"
Application.PrintOut FileName:="", Range:=wdPrintAllDocument, Item:= _
        wdPrintDocumentContent, Copies:=1, Pages:="", _
        PageType:=wdPrintAllPages, _
        ManualDuplexPrint:=False, Collate:=True, Background:=True, _
        PrintToFile:= _
        False, PrintZoomColumn:=0, PrintZoomRow:=0, PrintZoomPaperWidth:=0, _
        PrintZoomPaperHeight:=0
        Printer.PaperBin = wdPRBNMiddle
ActiveDocument.PrintOut
 
End Sub

_________________________
Professionelle Entwicklerkomponenten
www.tools4vb.de

=================================
[ZITAT]
Zwei Dinge sind unendlich, das Universum und die menschliche Dummheit, aber bei dem Universum bin ich mir noch nicht ganz sicher. - Albert Einstein

Public vbPrinter As Printer
Public vbPrinters As New Collection
 
Private pClass As New vbPrinter.Class1
'===========================================
Private sub Drucken
Dim PrinterName as String
 
PrinterName = "HP LaserJet 5400"
 
Debug.Print "START================="
    For i = 0 To pClass.vbPrinters.Count - 1
        Debug.Print pClass.vbPrinters(i + 1).DeviceName
        If pClass.vbPrinters(i + 1).DeviceName = PrinterName Then
            Set Printer = vbPrinter
            Debug.Print "Gefunden: " & pClass.vbPrinters(i + 1).DeviceName
            Exit For
        End If
    Next i
Debug.Print "ENDE=================="
end sub

For Each vbPrinter In Printers
    Falls der vorhandene Drucker mit dem PrinterName
    übereinstimmt, wird dieser als "Printer"
    festgelegt (Set Printer = vbPrinter ).
        Debug.Print vbPrinter.DeviceName
        If vbPrinter.DeviceName = PrinterName Then
            Set Printer = vbPrinter
            Debug.Print "Drucker ausgewählt: " & vbPrinter.DeviceName
            Exit For
        End If
Next vbPrinter

=================================
[ZITAT]
Zwei Dinge sind unendlich, das Universum und die menschliche Dummheit, aber bei dem Universum bin ich mir noch nicht ganz sicher. - Albert Einstein