Well, I've given up on the use of the xlBuiltinDialog PrinterSetup as it doesn't work across XL versions and/or Windows OS's? It also doesn't accept arguments even though a dialog should? It seems that my only resolution is to build my own special purpose userform for setting the default printer. I'll post the code in case it's useful for others. Most of it comes from Juan Pablo Gonzalez at this thread with some adaptation.. https://www.mrexcel.com/forum/excel-...terSetup+error
Module code...
Option Explicit
'https://www.mrexcel.com/forum/excel-questions/20392-setting-specific-printer-excel.html?highlight=xlDialogPrinterSetup+error
'Thanks to Juan Pablo Gonzalez
Public Arr As Variant
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)
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
MsgBox "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
Public 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
Sub ChangePrinter()
Dim Tmpstr As String, LastOn As Long, PrintName As String
LastOn = InStrRev(Application.ActivePrinter, "on") - 1
Tmpstr = Right(Application.ActivePrinter, Len(Application.ActivePrinter) - LastOn)
PrintName = Left(Application.ActivePrinter, Len(Application.ActivePrinter) - Len(Tmpstr) - 1)
If MsgBox(prompt:="Current default printer is: " & PrintName & vbCrLf _
& "Do you want to change the Default Printer?", Buttons:=vbYesNo, Title:="Change Default Printer") = vbYes Then
Arr = ListPrinters
UserForm1.Show
End If
End Sub
Userform1 that has a Listbox1 code...
Option Explicit
Private Sub ListBox1_Click()
Dim i As Integer
For i = LBound(Arr) To UBound(Arr)
If InStr(1, Arr(i), UserForm1.ListBox1.List(UserForm1.ListBox1.ListIndex), 1) > 0 Then
SetActivePrinter CStr(Arr(i))
Exit For
End If
Next i
UserForm1.Caption = "Default Printer: " & CStr(Arr(i))
End Sub
Private Sub UserForm_Initialize()
Dim i As Integer, Tmpstr As String, LastOn As Long, PrintName As String
For i = LBound(Arr) To UBound(Arr)
UserForm1.ListBox1.AddItem Arr(i)
Next i
LastOn = InStrRev(Application.ActivePrinter, "on") - 1
Tmpstr = Right(Application.ActivePrinter, Len(Application.ActivePrinter) - LastOn)
PrintName = Left(Application.ActivePrinter, Len(Application.ActivePrinter) - Len(Tmpstr) - 1)
UserForm1.Caption = "Default Printer: " & PrintName
End Sub
To operate...
Solved. Dave
Reply With Quote
