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
        'Debug.Print strPrinterName
    Next iIndex
End If
 
ListPrinters = strPrinters
MsgBox$ Join(ListPrinters, vbCrLf)
 
End Function
 
Private Sub UserForm_Activate()
 
    Selection.TypeText Text:=Join(ListPrinters, vbCrLf)
    
End Sub