Hoe kan ik in VBA de printerlade's van een netwerkprinter achterhalen?
Krijg overal de volgende code, maar krijg hem niet werkend. Ik heb een userform aangemaakt met een ListBox1.List = GetBinNames. Maar als de macro start krijg ik geen gegevens.
Sinds 2 weken hebben wij windows XP, en werkt de oude macro niet meer.
Hier waren de printerlade's 258,259,260. Maar met deze macro geeft de printer nu een foutmelding, "papierlade vullen"
Wie kan mij helpen?
Alvast bedankt!
Option Explicit
Private Const DC_BINS = 6
Private Const DC_BINNAMES = 12
Private Declare Function DeviceCapabilities Lib "winspool.drv" _
Alias "DeviceCapabilitiesA" (ByVal lpDeviceName As String, _
ByVal lpPort As String, ByVal iIndex As Long, lpOutput As Any, _
ByVal dev As Long) As Long
Public Function GetBinNumbers() As Variant
'Code adapted from Microsoft KB article Q194789
'HOWTO: Determine Available PaperBins with DeviceCapabilities API
Dim iBins As Long
Dim iBinArray() As Integer
Dim sPort As String
Dim sCurrentPrinter As String
'Get the printer & port name of the current printer
sPort = Trim$(Mid$(ActivePrinter, InStrRev(ActivePrinter, " ") + 1))
sCurrentPrinter = Trim$(Left$(ActivePrinter, _
InStr(ActivePrinter, " on ")))
'Find out how many printer bins there are
iBins = DeviceCapabilities(sCurrentPrinter, sPort, _
DC_BINS, ByVal vbNullString, 0)
'Set the array of bin numbers to the right size
ReDim iBinArray(0 To iBins - 1)
'Load the array with the bin numbers
iBins = DeviceCapabilities(sCurrentPrinter, sPort, _
DC_BINS, iBinArray(0), 0)
'Return the array to the calling routine
GetBinNumbers = iBinArray
End Function
Public Function GetBinNames() As Variant
'Code adapted from Microsoft KB article Q194789
'HOWTO: Determine Available PaperBins with DeviceCapabilities API
Dim iBins As Long
Dim ct As Long
Dim sNamesList As String
Dim sNextString As String
Dim sPort As String
Dim sCurrentPrinter As String
Dim vBins As Variant
'Get the printer & port name of the current printer
sPort = Trim$(Mid$(ActivePrinter, InStrRev(ActivePrinter, " ") + 1))
sCurrentPrinter = Trim$(Left$(ActivePrinter, _
InStr(ActivePrinter, " on ")))
'Find out how many printer bins there are
iBins = DeviceCapabilities(sCurrentPrinter, sPort, _
DC_BINS, ByVal vbNullString, 0)
'Set the string to the right size to hold all the bin names
'24 chars per name
sNamesList = String(24 * iBins, 0)
'Load the string with the bin names
iBins = DeviceCapabilities(sCurrentPrinter, sPort, _
DC_BINNAMES, ByVal sNamesList, 0)
'Set the array of bin names to the right size
ReDim vBins(0 To iBins - 1)
For ct = 0 To iBins - 1
'Get each bin name in turn and assign to the next item in the array
sNextString = Mid(sNamesList, 24 * ct + 1, 24)
vBins(ct) = Left(sNextString, InStr(1, sNextString, Chr(0)) - 1)
Next ct
'Return the array to the calling routine
GetBinNames = vBins
End Function
Sub Printen()
'
' Printen Macro
' Macro gemaakt op 12-9-2006 door jacktm
'
End Sub
Krijg overal de volgende code, maar krijg hem niet werkend. Ik heb een userform aangemaakt met een ListBox1.List = GetBinNames. Maar als de macro start krijg ik geen gegevens.
Sinds 2 weken hebben wij windows XP, en werkt de oude macro niet meer.
Hier waren de printerlade's 258,259,260. Maar met deze macro geeft de printer nu een foutmelding, "papierlade vullen"
Wie kan mij helpen?
Alvast bedankt!
Option Explicit
Private Const DC_BINS = 6
Private Const DC_BINNAMES = 12
Private Declare Function DeviceCapabilities Lib "winspool.drv" _
Alias "DeviceCapabilitiesA" (ByVal lpDeviceName As String, _
ByVal lpPort As String, ByVal iIndex As Long, lpOutput As Any, _
ByVal dev As Long) As Long
Public Function GetBinNumbers() As Variant
'Code adapted from Microsoft KB article Q194789
'HOWTO: Determine Available PaperBins with DeviceCapabilities API
Dim iBins As Long
Dim iBinArray() As Integer
Dim sPort As String
Dim sCurrentPrinter As String
'Get the printer & port name of the current printer
sPort = Trim$(Mid$(ActivePrinter, InStrRev(ActivePrinter, " ") + 1))
sCurrentPrinter = Trim$(Left$(ActivePrinter, _
InStr(ActivePrinter, " on ")))
'Find out how many printer bins there are
iBins = DeviceCapabilities(sCurrentPrinter, sPort, _
DC_BINS, ByVal vbNullString, 0)
'Set the array of bin numbers to the right size
ReDim iBinArray(0 To iBins - 1)
'Load the array with the bin numbers
iBins = DeviceCapabilities(sCurrentPrinter, sPort, _
DC_BINS, iBinArray(0), 0)
'Return the array to the calling routine
GetBinNumbers = iBinArray
End Function
Public Function GetBinNames() As Variant
'Code adapted from Microsoft KB article Q194789
'HOWTO: Determine Available PaperBins with DeviceCapabilities API
Dim iBins As Long
Dim ct As Long
Dim sNamesList As String
Dim sNextString As String
Dim sPort As String
Dim sCurrentPrinter As String
Dim vBins As Variant
'Get the printer & port name of the current printer
sPort = Trim$(Mid$(ActivePrinter, InStrRev(ActivePrinter, " ") + 1))
sCurrentPrinter = Trim$(Left$(ActivePrinter, _
InStr(ActivePrinter, " on ")))
'Find out how many printer bins there are
iBins = DeviceCapabilities(sCurrentPrinter, sPort, _
DC_BINS, ByVal vbNullString, 0)
'Set the string to the right size to hold all the bin names
'24 chars per name
sNamesList = String(24 * iBins, 0)
'Load the string with the bin names
iBins = DeviceCapabilities(sCurrentPrinter, sPort, _
DC_BINNAMES, ByVal sNamesList, 0)
'Set the array of bin names to the right size
ReDim vBins(0 To iBins - 1)
For ct = 0 To iBins - 1
'Get each bin name in turn and assign to the next item in the array
sNextString = Mid(sNamesList, 24 * ct + 1, 24)
vBins(ct) = Left(sNextString, InStr(1, sNextString, Chr(0)) - 1)
Next ct
'Return the array to the calling routine
GetBinNames = vBins
End Function
Sub Printen()
'
' Printen Macro
' Macro gemaakt op 12-9-2006 door jacktm
'
End Sub
