Juan Pablo González
MrExcel MVP
- Joined
- Feb 8, 2002
- Messages
- 11,959
Hello guys, I had been dealing with this issue for a while, fonud a solution in google, by reconstructing code from here and there. The "Test" sub first returns an array of all installed printers, then, in the For Next loop, I look for the Acrobat Distiller printer, which is the one I'm interested right now. I call the SetActivePrinter from there, wich sets Excel's ActivePrinter to the right port, wich was the big issue.
I did the Loop JUST IN CASE, because I could just do the
SetActivePrinter "Acrobat Distiller"
Here's the code, all in a standard module. The example doesn't do much by itself, just assigns the ActivePrinter to the Distiller, and then restores the "old" printer back, but I'm just showing that it can be done with VBA.
I did the Loop JUST IN CASE, because I could just do the
SetActivePrinter "Acrobat Distiller"
Here's the code, all in a standard module. The example doesn't do much by itself, just assigns the ActivePrinter to the Distiller, and then restores the "old" printer back, but I'm just showing that it can be done with VBA.
Code:
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
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
Declare Function GetProfileString& Lib "Kernel32" Alias "GetProfileStringA" _
(ByVal lpApplicationName As String, ByVal lpKeyName As String, _
ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Integer)
Sub Test()
Dim a As Variant
Dim st As String
Dim i As Integer
Dim port As Integer
st = Application.ActivePrinter
a = ListPrinters
For i = LBound(a) To UBound(a)
If InStr(1, a(i), "Distiller", 1) > 0 Then
SetActivePrinter CStr(a(i))
Exit For
End If
Next i
MsgBox Application.ActivePrinter
Application.ActivePrinter = st
End Sub
Private 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
bSuccess = EnumPrinters(PRINTER_ENUM_CONNECTIONS Or PRINTER_ENUM_LOCAL, vbNullString, _
1, iBuffer(0), iBufferSize, iBufferRequired, iEntries)
If bSuccess Then
If iBufferRequired > iBufferSize Then
iBufferSize = iBufferRequired
Debug.Print "iBuffer too small. Trying again with "; iBufferSize & " bytes."
ReDim iBuffer(iBufferSize 4) As Long
bSuccess = EnumPrinters(PRINTER_ENUM_CONNECTIONS Or PRINTER_ENUM_LOCAL, vbNullString, _
1, iBuffer(0), iBufferSize, iBufferRequired, iEntries)
If Not bSuccess Then
MsgBox "Error enumerating printers."
Exit Function
End If
End If
ReDim strPrinters(iEntries - 1)
For iIndex = 0 To iEntries - 1
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
Private Sub SetActivePrinter(strPrinterName As String)
Dim strBuffer As String
Dim lngRetValue As Long
Dim strDriverName As String
Dim strPrinterPort As String
strBuffer = Space(1024)
lngRetValue = GetProfileString("PrinterPorts", strPrinterName, "", _
strBuffer, Len(strBuffer))
' Parse the driver name and port name out of the buffer
GetDriverAndPort strBuffer, strDriverName, strPrinterPort
If strDriverName <> "" And strPrinterPort <> "" Then
' Changed the " on " to " en " to suit Spanish needs...
' Application.ActivePrinter = strPrinterName & " on " & strPrinterPort
Application.ActivePrinter = strPrinterName & " en " & strPrinterPort
End If
End Sub
Private Sub GetDriverAndPort(ByVal buffer As String, DriverName As String, PrinterPort As String)
Dim iDriver As Integer
Dim iPort As Integer
DriverName = ""
PrinterPort = ""
' The driver name is first in the string terminated by a comma
iDriver = InStr(buffer, ",")
If iDriver > 0 Then
' Strip out the driver name
DriverName = Left(buffer, iDriver - 1)
' The port name is the second entry after the driver name
' separated by commas.
iPort = InStr(iDriver + 1, buffer, ",")
If iPort > 0 Then
' Strip out the port name
PrinterPort = Mid(buffer, iDriver + 1, _
iPort - iDriver - 1)
End If
End If
End Sub