UtterAccess.com
X   Site Message
(Message will auto close in 2 seconds)

Welcome to UtterAccess! Please ( Login   or   Register )

Custom Search
 
   Reply to this topicStart new topic
> List Printers, Any Version    
 
   
InOverMyHead
post Nov 24 2019, 07:55 PM
Post#1



Posts: 895
Joined: 3-March 11
From: Sydney, Australia


Hi

I got this code from here and edited for #Win64 though it is returning nothing? It worked prior to the #Win64 changes, maybe that is the problem?
CODE
Option Explicit

Const PRINTER_ENUM_CONNECTIONS = &H4
Const PRINTER_ENUM_LOCAL = &H2

#If Win64 Then
    Private Declare PtrSafe 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
#Else
    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
#End If

#If Win64 Then
    Private Declare PtrSafe Function PtrToStr Lib "kernel32" Alias "lstrcpyA" _
            (ByVal RetVal As String, ByVal Ptr As Long) As Long
#Else
    Private Declare Function PtrToStr Lib "kernel32" Alias "lstrlenA" _
           (ByVal Ptr As Long, ByVal Ptr As Long) As Long
#End If

#If Win64 Then
    Private Declare PtrSafe Function StrLen Lib "kernel32" Alias "lstrlenA" _
       (ByVal Ptr As Long) As Long
#Else
    Private Declare Function StrLen Lib "kernel32" Alias "lstrlenA" _
       (ByVal Ptr As Long) As Long
#End If

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

Any help will be greatly appreciated grin.gif

John
Go to the top of the page
 
June7
post Nov 24 2019, 08:01 PM
Post#2



Posts: 998
Joined: 25-January 16



Maybe.

Have you set a breakpoint and step debugged?

This post has been edited by June7: Nov 24 2019, 08:02 PM

--------------------
Attachments Manager is below the edit post window. To provide db: copy, remove confidential data, run compact & repair, zip w/Windows Compression.
DEBUG! DEBUG! DEBUG! http://www.cpearson.com/Excel/DebuggingVBA.aspx
Go to the top of the page
 


Custom Search


RSSSearch   Top   Lo-Fi    6th December 2019 - 06:20 AM