'//UserForm code
 
Private Sub UserForm_Initialize() 
    EnumeratePrintersWin 
End Sub 
 
Private Sub ListBox1_Click() 
    CommandButton1.SetFocus 
End Sub 
 
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean) 
    DoPrint 
End Sub 
 
Private Sub TextBox1_AfterUpdate() 
    CommandButton1.SetFocus 
End Sub 
 
Private Sub CommandButton1_Click() 
    DoPrint 
End Sub 
 
Private Sub DoPrint() 
    Dim Temp As String 
     
    Temp = ActivePrinter 
     'Set default printer
    ActivePrinter = ListBox1.Value 
    Application.PrintOut , Copies:=TextBox1.Value 
     'Reinstate previous printer
    ActivePrinter = Temp 
    Unload UserForm1 
End Sub 
 
 
 
 '//Microsoft code (and OpenForm code) placed in a standard module
 
Option Explicit 
 
 'http://support.microsoft.com/default.aspx?scid=kb;en-us;200611
 'Adapted from ACC2000: Enumerating Local and Network Printers
 
Const PRINTER_ENUM_CONNECTIONS = &H4 
Const PRINTER_ENUM_LOCAL = &H2 
 
Type PRINTER_INFO_1 
    flags As Long 
    pDescription As String 
    PName As String 
    PComment As String 
End Type 
 
Type PRINTER_INFO_4 
    pPrinterName As String 
    pServerName As String 
    Attributes As Long 
End Type 
 
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 
Declare Function PtrToStr Lib "Kernel32" Alias "lstrcpyA" _ 
(ByVal RetVal As String, ByVal Ptr As Long) As Long 
Declare Function StrLen Lib "Kernel32" Alias "lstrlenA" _ 
(ByVal Ptr As Long) As Long 
 
 
Sub EnumeratePrintersWin() 
     
    Dim Success As Boolean, cbRequired As Long, cbBuffer As Long 
    Dim Buffer() As Long, nEntries As Long 
    Dim I As Long, PFlags As Long, PDesc As String, PName As String 
    Dim PComment As String, Temp As Long 
     
    cbBuffer = 3072 
    ReDim Buffer((cbBuffer \ 4) - 1) As Long 
    Success = EnumPrinters(PRINTER_ENUM_CONNECTIONS Or _ 
    PRINTER_ENUM_LOCAL, _ 
    vbNullString, _ 
    1, _ 
    Buffer(0), _ 
    cbBuffer, _ 
    cbRequired, _ 
    nEntries) 
    If Success Then 
        If cbRequired > cbBuffer Then 
            cbBuffer = cbRequired 
            Debug.Print "Buffer too small.  Trying again with " & _ 
            cbBuffer & " bytes." 
            ReDim Buffer(cbBuffer \ 4) As Long 
            Success = EnumPrinters(PRINTER_ENUM_CONNECTIONS Or _ 
            PRINTER_ENUM_LOCAL, _ 
            vbNullString, _ 
            1, _ 
            Buffer(0), _ 
            cbBuffer, _ 
            cbRequired, _ 
            nEntries) 
            If Not Success Then 
                Debug.Print "Error enumerating printers." 
                Exit Sub 
            End If 
        End If 
         'Revised from posted code (see below)*************
        For I = 0 To nEntries - 1 
            PName = Space$(StrLen(Buffer(I * 4 + 2))) 
            Temp = PtrToStr(PName, Buffer(I * 4 + 2)) 
            UserForm1.ListBox1.AddItem PName 
        Next I 
    End If 
     '*************************************
End Sub 
 
 'For I = 0 To nEntries - 1
 'PName = Space$(StrLen(Buffer(I * 3)))
 'Temp = PtrToStr(PName, Buffer(I * 3))
 'SName = Space$(StrLen(Buffer(I * 3 + 1)))
 'Temp = PtrToStr(SName, Buffer(I * 3 + 1))
 'Attrib = Buffer(I * 3 + 2)
 'Debug.Print "Printer: " & PName, "Server: " & SName, _
 '            "Attributes: " & Hex$(Attrib)
 'Next I
 'Else
 '   Debug.Print "Error enumerating printers."
 'End If
 
 
Sub ShowForm() 
    UserForm1.Show False 
End Sub