gary_j
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!
Thank you very much!
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.
A quick method would be to read the Registry keys at:
HKEY_CURRENT_USER\Printers
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_ CONNECTION S 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_ CONNECTION S 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_ CONNECTION S 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_ CONNECTION S 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.
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_
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_
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_
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_
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_ CONNECTION S 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_ CONNECTION S 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.pP rinterName )
PortName = copyString(tPrinterList.pP ortName)
DriverName = copyString(tPrinterList.pD riverName)
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
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_
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_
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.pP
PortName = copyString(tPrinterList.pP
DriverName = copyString(tPrinterList.pD
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
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
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.
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.
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 ...
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_CUR RENT_USER, "Software\Microsoft\WIndow s NT\CurrentVersion\Windows" , "Device")
‘ Set default printer to PDF Writer
SaveRegistryString HKEY_CURRENT_USER, "Software\Microsoft\WIndow s 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\WIndow s 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.
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_CUR
‘ Set default printer to PDF Writer
SaveRegistryString HKEY_CURRENT_USER, "Software\Microsoft\WIndow
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\WIndow
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
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
that last one was the article i was looking for.
thanks!
thanks!
In which MS-Office application are using using VBA?
Thanks for your clarification.
BFN,
fp.