Link to home
Start Free TrialLog in
Avatar of gary_j
gary_jFlag for United States of America

asked on

vba printer object api options

Since VBA does not include the printer object, I need to know if (and which) api's are available to determine all printers available to the work station, and to print to the chosen printer (not necessarily the default printer).  This will NOT be a line printer (if that makes a difference).

Thank you very much!
Avatar of [ fanpages ]
[ fanpages ]

Hi,

In which MS-Office application are using using VBA?

Thanks for your clarification.

BFN,

fp.
Avatar of gary_j

ASKER

actually it's not ms-office, it's another software package that i'm not at liberty to disclose -- but for the most part, it works just like any macros i've written for Excel ...
...it's hard to suggest methods on second-guessing what the programmatic interface is.

A quick method would be to read the Registry keys at:

HKEY_CURRENT_USER\Printers\Settings

But to address you question, "WNetOpenEnum" should be used with the RESOURCETYPE_PRINT (dwType) flag.

Declare Function WNetOpenEnum Lib "mpr.dll" Alias "WNetOpenEnumA" (ByVal dwScope As Long, ByVal dwType As Long, ByVal dwUsage As Long, lpNetResource As NETRESOURCE, lphEnum As Long) As Long


A summary of the parameters can be found here:

[ http://www.mentalis.org/apilist/WNetOpenEnum.shtml ]

BFN,

fp.



PS.

This MSDN article on "Enumerating Local and Network Printers" (in MS-Access, but will work elsewhere) may also help:

[ http://support.microsoft.com/kb/q166008/ ]

1. Create a module and type the following lines in the Declarations section:

      Option Explicit

      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
                              
 
2. Type the following procedures:

      Sub EnumeratePrinters1()
      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
         Debug.Print "There are " & nEntries & _
                      " local and connected printers."
         For I = 0 To nEntries - 1
            PFlags = Buffer(4 * I)
            PDesc = Space$(StrLen(Buffer(I * 4 + 1)))
            Temp = PtrToStr(PDesc, Buffer(I * 4 + 1))
            PName = Space$(StrLen(Buffer(I * 4 + 2)))
            Temp = PtrToStr(PName, Buffer(I * 4 + 2))
            PComment = Space$(StrLen(Buffer(I * 4 + 2)))
            Temp = PtrToStr(PComment, Buffer(I * 4 + 2))
            Debug.Print PFlags, PDesc, PName, PComment
         Next I
         Else
            Debug.Print "Error enumerating printers."
         End If
      End Sub

      Sub EnumeratePrinters4()
      Dim Success As Boolean, cbRequired As Long, cbBuffer As Long
      Dim Buffer() As Long, nEntries As Long
      Dim I As Long, PName As String, SName As String
      Dim Attrib As Long, Temp As Long
         cbBuffer = 3072
         ReDim Buffer((cbBuffer \ 4) - 1) As Long
         Success = EnumPrinters(PRINTER_ENUM_CONNECTIONS Or _
                               PRINTER_ENUM_LOCAL, _
                               vbNullString, _
                               4, _
                               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, _
                                   4, _
                                   Buffer(0), _
                                   cbBuffer, _
                                   cbRequired, _
                                   nEntries)
               If Not Success Then
                  Debug.Print "Error enumerating printers."
                  Exit Sub
               End If
            End If
            Debug.Print "There are " & nEntries & _
                      " local and connected printers."
            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
      End Sub
 


BFN,

fp.
Another example...

Option Explicit

Private Const PRINTER_ENUM_CONNECTIONS = &H4
Private Const PRINTER_ENUM_LOCAL = &H2
Private Const HWND_BROADCAST = &HFFFF&
Private Const WM_WININICHANGE = &H1A
Private Const SMTO_NORMAL = &H0

Private Type PRINTER_INFO_2
    pServerName As Long
    pPrinterName As Long
    pShareName As Long
    pPortName As Long
    pDriverName As Long
    pComment As Long
    pLocation As Long
    otherBytes(55) As Byte      'Not interested in the rest of the structure
End Type


Private Declare Sub RtlMoveMemory Lib "kernel32" (Destination As Any, Source As Any, ByVal Length As Long)

Private Declare Function EnumPrinters Lib "winspool.drv" Alias "EnumPrintersA" _
   (ByVal flags As Long, ByVal name As String, _
   ByVal Level As Long, pPrinterEnum As Any, 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 GetLastError Lib "kernel32" () As Long

Private Declare Function WriteProfileString Lib "kernel32" Alias "WriteProfileStringA" (ByVal lpszSection As String, ByVal lpszKeyName As String, ByVal lpszString As String) As Long
Private Declare Function SendMessageTimeout Lib "user32" Alias "SendMessageTimeoutA" (ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As String, ByVal fuFlags As Long, ByVal uTimeout As Long, lpdwResult As Long) As Long
Public Function CreatePrinterList() As String

    'Returns printer list in two column Access combobox format
    'First column is printer name, second is profile string
   
    Const BUFFER_INITIAL_SIZE = 1024

    Dim Success As Boolean, cbRequired As Long
    Dim Buffer() As Byte, nEntries As Long, tPrinterList As PRINTER_INFO_2
    Dim PrinterName As String, PortName As String, DriverName As String
    Dim errorNum As Long, structsize As Long
    Dim i As Integer
    Dim temp As String
   
    structsize = LenB(tPrinterList)
   
    ReDim Buffer(BUFFER_INITIAL_SIZE)
   
    'Get printer list
    Success = EnumPrinters(PRINTER_ENUM_CONNECTIONS Or _
                          PRINTER_ENUM_LOCAL, _
                          vbNullString, _
                          2, _
                          Buffer(0), _
                          BUFFER_INITIAL_SIZE, _
                          cbRequired, _
                          nEntries)
   
    If Not Success Then 'try again with larger buffer
        ReDim Buffer(cbRequired)
         Success = EnumPrinters(PRINTER_ENUM_CONNECTIONS Or _
                      PRINTER_ENUM_LOCAL, _
                      vbNullString, _
                      2, _
                      Buffer(0), _
                      cbRequired, _
                      cbRequired, _
                      nEntries)
         errorNum = GetLastError
    End If
   
    If Success Then
        For i = 0 To nEntries - 1
            RtlMoveMemory tPrinterList, Buffer(i * structsize), structsize
            PrinterName = copyString(tPrinterList.pPrinterName)
            PortName = copyString(tPrinterList.pPortName)
            DriverName = copyString(tPrinterList.pDriverName)
            temp = temp & PrinterName & ";""" & PrinterName & "," & PortName & "," & DriverName & """;"
        Next
    Else 'second try failed too -- can't get list of printers
       temp = "Couldn't list printers - Error#: " & errorNum & ";;"
    End If
   
    CreatePrinterList = temp
   
End Function
Private Function copyString(pstrSource As Long) As String
    Dim temp As String, location As Integer
    Dim lng As Long
   
    temp = Space$(1024)
    lng = PtrToStr(temp, pstrSource)
    location = InStr(1, temp, Chr$(0))
    copyString = IIf(location > 0, Left$(temp, location - 1), "")
   
End Function
Avatar of gary_j

ASKER

Hi fp,

Thanks very much for your help.  Both are nice solutions for returning the printer list, and I appreciate it!

Now, as to the second part of the question:  I need to know which api calls to use to print to the selected printer.

(I will have the user choose from a list, and so will know the printer name per the "createPrinterList" function you gave me)

Thanks again,
Gary
Hi,

You may need to store the existing "Default Printer", then reset it to the selected printer from the list, print your output, then restore to the previous setting you have stored.

Is this a feasible solution?

BFN,

fp.
Avatar of gary_j

ASKER

since the printer object does not exist in vba, i don't know how to do this.  I think I can just send the print job to the selected printer without changing the Windows default, but I don't know which api(s) to use to do that ...
Avatar of gary_j

ASKER

or which api's to use to return or set the Windows default printer
Hi,

I was proposing something like this (that outputs an Access report to a PDF file, by changing the default printer to Adobe PDFWrite, "printing", then returning the default printer device thereafter):

Public Sub RunReportAsPDF
On Error GoTo Err_RunReport

‘ Folder where PDF file will be written
sPDFPath = “C:\myapp\archive\”

‘ Save current default printer
sMyDefPrinter = GetRegistryString(HKEY_CURRENT_USER, "Software\Microsoft\WIndows NT\CurrentVersion\Windows", "Device")
‘ Set default printer to PDF Writer
SaveRegistryString HKEY_CURRENT_USER, "Software\Microsoft\WIndows NT\CurrentVersion\Windows", "Device", "Acrobat PDFWriter"

sPDFName = “myReport.pdf"
‘ Setting value for PDFFileName in the registry stops file dialog box from appearing
SaveRegistryString HKEY_CURRENT_USER, "Software\Adobe\Acrobat PDFWriter", "PDFFileName", sPDFPath + sPDFName

‘ Run the report
DoCmd.OpenReport “myReport”, acPreview
   
Exit_RunReport:
    ' Restore default printer
    SaveRegistryString HKEY_CURRENT_USER, "Software\Microsoft\WIndows NT\CurrentVersion\Windows", "Device", sMyDefPrinter
    Exit Sub

Err_RunReport:
    MsgBox Err.Description
    Resume Exit_RunReport
   
End Sub


See also [ http://www.microsoft.com/AccessDev/Articles/GetzCh10.HTM ] for API calls.

BFN,

fp.
ASKER CERTIFIED SOLUTION
Avatar of [ fanpages ]
[ fanpages ]

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of gary_j

ASKER

that last one was the article i was looking for.

thanks!
Thanks for the points/grading.

BFN,

fp.
[ http://NigelLee.info ]