Drucker auslesen
16.03.2008 13:42:43
Sonnenpeter
ich habe in der Recherche das nauchfolgende Makro gefunden.
Private Declare Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyA" (ByVal lpString1 As String, ByVal lpString2 As Long) As Long
Private Declare Function lstrlen Lib "kernel32.dll" Alias "lstrlenA" (ByVal lpString As Long) As Long
Private Declare Function EnumPrinters Lib "winspool.drv" Alias "EnumPrintersA" (ByVal flags As Long, ByVal name As String, ByVal Level As Long, pPrinterEnum As Long, ByVal cdBuf As Long, pcbNeeded As Long, pcReturned As Long) As Long
Const PRINTER_ENUM_LOCAL = &H2
Private Type PRINTER_INFO_1
flags As Long
pDescription As String
pName As String
pComment As String
End Type
Private Sub Installierte_Drucker()
Dim LongBuffer() As Long
Dim Printinfo() As PRINTER_INFO_1
Dim NumBytes As Long
Dim NumNeeded As Long
Dim NumPrinters As Long
Dim c As Integer, RetVal As Long
NumBytes = 3076
ReDim LongBuffer(0 To NumBytes / 4) As Long
RetVal = EnumPrinters(PRINTER_ENUM_LOCAL, "", 1, LongBuffer(0), NumBytes, NumNeeded, _
NumPrinters)
If RetVal = 0 Then
NumBytes = NumNeeded
ReDim LongBuffer(0 To NumBytes / 4) As Long
RetVal = EnumPrinters(PRINTER_ENUM_LOCAL, "", 1, LongBuffer(0), NumBytes, NumNeeded, _
NumPrinters)
If RetVal = 0 Then
Debug.Print "Fehler aufgetretten!"
End
End If
End If
If NumPrinters 0 Then ReDim Printinfo(0 To NumPrinters - 1) As PRINTER_INFO_1
For c = 0 To NumPrinters - 1
Printinfo(c).flags = LongBuffer(4 * c)
Printinfo(c).pDescription = Space(lstrlen(LongBuffer(4 * c + 1)))
RetVal = lstrcpy(Printinfo(c).pDescription, LongBuffer(4 * c + 1))
Printinfo(c).pName = Space(lstrlen(LongBuffer(4 * c + 2)))
RetVal = lstrcpy(Printinfo(c).pName, LongBuffer(4 * c + 2))
Printinfo(c).pComment = Space(lstrlen(LongBuffer(4 * c + 3)))
RetVal = lstrcpy(Printinfo(c).pComment, LongBuffer(4 * c + 3))
Next c
For c = 0 To NumPrinters - 1
MsgBox Printinfo(c).pName
Next c
End Sub
Das Ganze funktioniert auch ohne Probleme. Als Ausgabe erhalte ich unter anderen "PDFCreator" geliefert.
Nur hätte ich gerne "PDFCreator auf Ne00:" oder "PDFCreator auf Ne01:" oder ähnliches.
'Application.ActivePrinter = "PDFCreator auf Ne00:"
Meine VBA- Kenntnisse reichen hierzu leider nicht.
Ist es Möglich auch "PDFCreator auf Ne00:" als Ausgabe zu erhalten, wen ja, wie?
Gruß Sonnenpeter