Create list of printers

[Borg2of6]

Help ......

I am using VBA in Excel and I have a form which I have created. On the form I need to put a drop down list box from which to select a printer.

The list of printers is not known at creation time as it is to be the list of printers installed on the current computer so that user can print to any attached printer.

Does anybody know a simple way to obtain the names for the printers that are installed. I do not want to use the xlDialogPrinterSetup as it allow the user to override my print setups.

Advise on how to populate the list box would also be helpful.

Thank you all for your help on this.

[cssriraman]

Hi,

It requires some Windows API trickery, because VBA (unlike VB) does not have a Printers collection. Paste the following into a separate module. The function ListPrinters returns a variant containing an array of printer names.

Option Explicit
 
Const PRINTER_ENUM_CONNECTIONS = &H4
Const PRINTER_ENUM_LOCAL = &H2
 
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
 
Private Declare Function PtrToStr Lib "kernel32" Alias "lstrcpyA" _
        (ByVal RetVal As String, ByVal Ptr As Long) As Long
 
Private Declare Function StrLen Lib "kernel32" Alias "lstrlenA" _
       (ByVal Ptr As Long) As Long
 
Public Function ListPrinters() As Variant
Dim bSuccess As Boolean
Dim iBufferRequired As Long
Dim iBufferSize As Long
Dim iBuffer() As Long
Dim iEntries As Long
Dim iIndex As Long
Dim strPrinterName As String
Dim iDummy As Long
Dim iDriverBuffer() As Long
Dim strPrinters() As String
iBufferSize = 3072
ReDim iBuffer((iBufferSize \ 4) - 1) As Long
'EnumPrinters will return a value False if the buffer is not big enough
bSuccess = EnumPrinters(PRINTER_ENUM_CONNECTIONS Or _
        PRINTER_ENUM_LOCAL, vbNullString, _
        1, iBuffer(0), iBufferSize, iBufferRequired, iEntries)
If Not bSuccess Then
    If iBufferRequired > iBufferSize Then
        iBufferSize = iBufferRequired
        Debug.Print "iBuffer too small. Trying again with "; _
        iBufferSize & " bytes."
        ReDim iBuffer(iBufferSize \ 4) As Long
    End If
    'Try again with new buffer
    bSuccess = EnumPrinters(PRINTER_ENUM_CONNECTIONS Or _
            PRINTER_ENUM_LOCAL, vbNullString, _
            1, iBuffer(0), iBufferSize, iBufferRequired, iEntries)
End If
If Not bSuccess Then
    'Enumprinters returned False
    MsgBox "Error enumerating printers."
    Exit Function
Else
    'Enumprinters returned True, use found printers to fill the array
    ReDim strPrinters(iEntries - 1)
    For iIndex = 0 To iEntries - 1
        'Get the printername
        strPrinterName = Space$(StrLen(iBuffer(iIndex * 4 + 2)))
        iDummy = PtrToStr(strPrinterName, iBuffer(iIndex * 4 + 2))
        strPrinters(iIndex) = strPrinterName
    Next iIndex
End If
ListPrinters = strPrinters
End Function 
 
'You could call the function as follows: 
Sub Test()
Dim StrPrinters As Variant, x As Long
StrPrinters = ListPrinters
'Fist check whether the array is filled with anything, by calling another function, IsBounded.
If IsBounded(StrPrinters) Then 
    For x = LBound(strPrinters) To UBound(strPrinters)
        Debug.Print StrPrinters(x)
    Next x
Else
    Debug.Print "No printers found"
End If
End Sub 
 
Public Function IsBounded(vArray As Variant) As Boolean
    'If the variant passed to this function is an array, the function will return True;
    'otherwise it will return False 
    On Error Resume Next
    IsBounded = IsNumeric(UBound(vArray))
End Function

Let me know if you need any help on this.

[Borg2of6]

Thank you for the code above.

I have now got the program to display the list of available printers on the workstation.

However if I try to change the printer I get an error: "Run-Time error 1004: Method Activeprinter of object -Application Failed."

Checking for values I notice that the current active printer has a value in format "\\XXX9999\XXX99999 on XX99". The value take from the combobox (ie the printer name) is in the format "\\XXX9999\XXX99999".

Please can you advise how I can get the system name so that I can change the printer.

As I am wanting this program to be used by various people I do not know the format for everyones printers.

Thank you in advance for advice.

[Borg2of6]

Does any body know how to read the printers name so that it can be used to set the activeprinter property?

[cssriraman]

Yes! I got the same problem in Excel. But it works fine for me in Word. Is there anybody to fix this issue?

[lexII]

Guessing that your trying to set a networked printer as the activeprinter (by the "on xx99").

This is the code i use at work to send a print job to a printer i'd chosen, in this case the printer is called "Stock Control"
and "\\root" is our servers name, where all the printer drivers are installed.
Using the code above to allow a user to choose the printer (novel idea ) drop the printer
name into a variable and use this instead of "Stock Control" when you call the function.
The function just loops thru on Ne00: to Ne99: testing each one until it finds the correct network address for the printer.
It also resets the users default printer back after the jobs printed. (strCurrentPrinter)
Hope this helps...

Function GetFullNetworkPrinterName(strNetworkPrinterName As String) As String
' returns the full network printer name
' returns an empty string if the printer is not found
' e.g. GetFullNetworkPrinterName("\\root\Stock Control") 
Dim strCurrentPrinterName As String, strTempPrinterName As String, i As Long
    strCurrentPrinterName = Application.ActivePrinter
    i = 0
    Do While i < 100
        strTempPrinterName = strNetworkPrinterName & " on Ne" & Format(i, "00") & ":"
        On Error Resume Next ' try to change to the network printer
        Application.ActivePrinter = strTempPrinterName
        On Error GoTo 0
        If Application.ActivePrinter = strTempPrinterName Then
            ' the network printer was found
            GetFullNetworkPrinterName = strTempPrinterName
            i = 100 ' makes the loop end
        End If
        i = i + 1
    Loop
    ' remove the line below if you want the function to change the active printer
    Application.ActivePrinter = strCurrentPrinterName ' change back to the original printer
End Function

call it with:

strNetworkPrinter = GetFullNetworkPrinterName("\\root\Stock Control")
    If Len(strNetworkPrinter) > 0 Then ' found the network printer
        strCurrentPrinter = Application.ActivePrinter
        Application.ActivePrinter = strNetworkPrinter ' change to the network printer
        ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True ' Print active sheet on chosen printer
        Application.ActivePrinter = strCurrentPrinter ' change back to the previously active printer

[Borg2of6]

Any one know of a more direct route than the one suggested by LexII.

One I have tested his suggest I will update this thread with the result.

[Borg2of6]

Thank you to all who have helped on this. I have now got the printers to work.

I have used the info provided above to base my code on. The code that I have used is below.

To obtain names of the printers attached to the workstation:

Private Sub UserForm_Activate()
Dim owshNetwork As Object
Dim oPrinters As Object
Dim i As Long
Dim aryPrinters
Set owshNetwork = CreateObject("WScript.Network")
Set oPrinters = owshNetwork.EnumPrinterConnections
ReDim aryPrinters(0 To oPrinters.Count \ 2 - 1)
For i = 0 To oPrinters.Count - 1 Step 2
    aryPrinters(i \ 2) = oPrinters.Item(i + 1)
Next
qty = 1
Label2.Caption = qty
For i = 0 To Val(UBound(aryPrinters))
    ComboBox1.AddItem (aryPrinters(i))
Next i
ComboBox1.Text = Application.ActivePrinter
End Sub

To find the full name of the printer as required to set the active printer the code used is:

Sub CommandButton1_Click()
Dim strPrinter As String
Dim a As Integer
a = 1
Do While a < 100
    strPinter = ComboBox1.Text & " on Ne" & Format(a, "00") & ":"
    a = a + 1
    On Error Resume Next
    Application.ActivePrinter = strPrinter
    On Error GoTo 0
Loop
PrintCopies = Label2.Caption
Unload Me
End Sub

Thanks again. My application is now complete.