FIX: Setting Printer to Item in the Printers Collection Fails

• Microsoft Visual Basic Control Creation, Learning, Professional, and Enterprise Editions for Windows, version 5.0 on the following platforms: NT, Win95

SYMPTOMS

Attempting to set the default printer to an object variable has no effect. For instance, given a system with more than one printer installed, the following code will not change the default printer:

   Private Sub Form_Load()
       Dim Prt As Printer
       For Each Prt In Printers
      If Not Prt Is Printer Then
            Set Printer = Prt
         Exit For
      End If
       Next

      Printer.Print "Hi, Mom"
      Printer.EndDoc
   End Sub

The actual behavior is that the document prints to the original default printer.

RESOLUTION

*CAUTION* This workaround changes the default printer for all applications that are currently running.

The following code provides a means to determine which printers are available, and to designate one as the default printer.

1. Add the following code to a module:

         Declare Function GetProfileString Lib "kernel32" _
         Alias "GetProfileStringA" _
         (ByVal lpAppName As String, _
         ByVal lpKeyName As String, _
         ByVal lpDefault As String, _
         ByVal lpReturnedString As String, _
         ByVal nSize As Long) As Long
   

         Declare Function WriteProfileString Lib "kernel32" _
         Alias "WriteProfileStringA" _
         (ByVal lpszSection As String, _
         ByVal lpszKeyName As String, _
         ByVal lpszString As String) As Long
   

         Declare Function SendMessage Lib "user32" _
         Alias "SendMessageA" _
         (ByVal hwnd As Long, _
         ByVal wMsg As Long, _
         ByVal wParam As Long, _
         lparam As String) As Long
   

         Public Const HWND_BROADCAST = &HFFFF
         Public Const WM_WININICHANGE = &H1A
   

         Public Type OSVERSIONINFO
            dwOSVersionInfoSize As Long
            dwMajorVersion As Long
            dwMinorVersion As Long
            dwBuildNumber As Long
            dwPlatformId As Long
            szCSDVersion As String * 128
         End Type
   
         Declare Function GetVersionExA Lib "kernel32" _
         (lpVersionInformation As OSVERSIONINFO) As Integer
   
         Public Declare Function OpenPrinter Lib "winspool.drv" _
         Alias "OpenPrinterA" _
         (ByVal pPrinterName As String, _
         phPrinter As Long, _
         pDefault As PRINTER_DEFAULTS) As Long
   
         Public Declare Function SetPrinter Lib "winspool.drv" _
         Alias "SetPrinterA" _
         (ByVal hPrinter As Long, _
         ByVal Level As Long, _
         pPrinter As Any, _
         ByVal Command As Long) As Long
   
         Public Declare Function GetPrinter Lib "winspool.drv" _
         Alias "GetPrinterA" _
         (ByVal hPrinter As Long, _
         ByVal Level As Long, _
         pPrinter As Any, _
         ByVal cbBuf As Long, _
         pcbNeeded As Long) As Long
   
         Public Declare Function lstrcpy Lib "kernel32" _
         Alias "lstrcpyA" _
         (ByVal lpString1 As String, _
         ByVal lpString2 As Any) As Long
   
         Public Declare Function ClosePrinter Lib "winspool.drv" _
         (ByVal hPrinter As Long) As Long
   
         Public Declare Function GetLastError Lib "kernel32" () As Long
   
         ' constants for DEVMODE structure
         Public Const CCHDEVICENAME = 32
         Public Const CCHFORMNAME = 32
   
         ' constants for DesiredAccess member of PRINTER_DEFAULTS
         Public Const STANDARD_RIGHTS_REQUIRED = &HF0000
         Public Const PRINTER_ACCESS_ADMINISTER = &H4
         Public Const PRINTER_ACCESS_USE = &H8
         Public Const PRINTER_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or _
         PRINTER_ACCESS_ADMINISTER Or PRINTER_ACCESS_USE)
   
         ' constant that goes into PRINTER_INFO_5 Attributes member
         ' to set it as default
         Public Const PRINTER_ATTRIBUTE_DEFAULT = 4
   
         Public Type DEVMODE
                 dmDeviceName As String * CCHDEVICENAME
                 dmSpecVersion As Integer
                 dmDriverVersion As Integer
                 dmSize As Integer
                 dmDriverExtra As Integer
                 dmFields As Long
                 dmOrientation As Integer
                 dmPaperSize As Integer
                 dmPaperLength As Integer
                 dmPaperWidth As Integer
                 dmScale As Integer
                 dmCopies As Integer
                 dmDefaultSource As Integer
                 dmPrintQuality As Integer
                 dmColor As Integer
                 dmDuplex As Integer
                 dmYResolution As Integer
                 dmTTOption As Integer
                 dmCollate As Integer
                 dmFormName As String * CCHFORMNAME
                 dmLogPixels As Integer
                 dmBitsPerPel As Long
                 dmPelsWidth As Long
                 dmPelsHeight As Long
                 dmDisplayFlags As Long
                 dmDisplayFrequency As Long
                 dmICMMethod As Long        ' // Windows 95 only
                 dmICMIntent As Long        ' // Windows 95 only
                 dmMediaType As Long        ' // Windows 95 only
                 dmDitherType As Long       ' // Windows 95 only
                 dmReserved1 As Long        ' // Windows 95 only
                 dmReserved2 As Long        ' // Windows 95 only
         End Type
   
         Public Type PRINTER_INFO_5
                 pPrinterName As String
                 pPortName As String
                 Attributes As Long
                 DeviceNotSelectedTimeout As Long
                 TransmissionRetryTimeout As Long
         End Type
   
         Public Type PRINTER_DEFAULTS
                 pDatatype As Long
                 pDevMode As DEVMODE
                 DesiredAccess As Long
         End Type
   
   

2. Place a Listbox and a CommandButton on a form. Add the following code to the General Declarations section of the form:

         Option Explicit
   

         Private Function PtrCtoVbString(Add As Long) As String
   

             Dim sTemp As String * 512, x As Long
   
             x = lstrcpy(sTemp, Add)
             If (InStr(1, sTemp, Chr(0)) = 0) Then
                  PtrCtoVbString = ""
             Else
                  PtrCtoVbString = Left(sTemp, InStr(1, sTemp, Chr(0)) - 1)
             End If
         End Function
         Private Sub SetDefaultPrinter(ByVal PrinterName As String, _
             ByVal DriverName As String, ByVal PrinterPort As String)
             Dim DeviceLine As String
             Dim r As Long
             Dim l As Long
             DeviceLine = PrinterName & "," & DriverName & "," & PrinterPort
             ' Store the new printer information in the [WINDOWS] section of
             ' the WIN.INI file for the DEVICE= item
             r = WriteProfileString("windows", "Device", DeviceLine)
             ' Cause all applications to reload the INI file:
             l = SendMessage(HWND_BROADCAST, WM_WININICHANGE, 0, "windows")
         End Sub
   
         Private Sub Win95SetDefaultPrinter()
             Dim Handle As Long          'handle to printer
             Dim PrinterName As String
             Dim pd As PRINTER_DEFAULTS
             Dim x As Long
             Dim need As Long            ' bytes needed
             Dim pi5 As PRINTER_INFO_5   ' your PRINTER_INFO structure
             Dim LastError As Long
   
             ' determine which printer was selected
             PrinterName = List1.List(List1.ListIndex)
             ' none - exit
             If PrinterName = "" Then
                 Exit Sub
             End If
   
             ' set the PRINTER_DEFAULTS members
             pd.pDatatype = 0&
             pd.DesiredAccess = PRINTER_ALL_ACCESS
   
             ' Get a handle to the printer
             x = OpenPrinter(PrinterName, Handle, pd)
             ' failed the open
             If x = False Then
                 'error handler code goes here
                 Exit Sub
             End If
   
             ' Make an initial call to GetPrinter, requesting Level 5
             ' (PRINTER_INFO_5) information, to determine how many bytes
             ' you need
             x = GetPrinter(Handle, 5, ByVal 0&, 0, need)
             ' don't want to check GetLastError here - it's supposed to fail
             ' with a 122 - ERROR_INSUFFICIENT_BUFFER
             ' redim t as large as you need
             ReDim t((need \ 4)) As Long
   
             ' and call GetPrinter for keepers this time
             x = GetPrinter(Handle, 5, t(0), need, need)
             ' failed the GetPrinter
             If x = False Then
                 'error handler code goes here
                 Exit Sub
             End If
   
             ' set the members of the pi5 structure for use with SetPrinter.
             ' PtrCtoVbString copies the memory pointed at by the two string
             ' pointers contained in the t() array into a Visual Basic string.
             ' The other three elements are just DWORDS (long integers) and
             ' don't require any conversion
             pi5.pPrinterName = PtrCtoVbString(t(0))
             pi5.pPortName = PtrCtoVbString(t(1))
             pi5.Attributes = t(2)
             pi5.DeviceNotSelectedTimeout = t(3)
             pi5.TransmissionRetryTimeout = t(4)
   
             ' this is the critical flag that makes it the default printer
             pi5.Attributes = PRINTER_ATTRIBUTE_DEFAULT
   
             ' call SetPrinter to set it
             x = SetPrinter(Handle, 5, pi5, 0)
             ' failed the SetPrinter
             If x = False Then
                 MsgBox "SetPrinterFailed. Error code: " & GetLastError()
                 Exit Sub
             End If
   
             ' and close the handle
             ClosePrinter (Handle)
   
         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
   
           Private Sub ParseList(lstCtl As Control, ByVal Buffer As String)
             Dim i As Integer
   
             Dim s As String
   
             Do
                 i = InStr(Buffer, Chr(0))
                 If i > 0 Then
                     s = Left(Buffer, i - 1)
                     If Len(Trim(s)) Then lstCtl.AddItem s
                     Buffer = Mid(Buffer, i + 1)
                 Else
                     If Len(Trim(Buffer)) Then lstCtl.AddItem Buffer
                     Buffer = ""
                 End If
             Loop While i > 0
         End Sub
         Private Sub WinNTSetDefaultPrinter()
             Dim Buffer As String
             Dim DeviceName As String
             Dim DriverName As String
             Dim PrinterPort As String
             Dim PrinterName As String
             Dim r As Long
             If List1.ListIndex > -1 Then
                 'Get the printer information for the currently selected
                 'printer in the list. The information is taken from the
                 'WIN.INI file.
                 Buffer = Space(1024)
                 PrinterName = List1.Text
                 r = GetProfileString("PrinterPorts", PrinterName, "", _
                     Buffer, Len(Buffer))
   
                 'Parse the driver name and port name out of the buffer
                 GetDriverAndPort Buffer, DriverName, PrinterPort
   
                 If DriverName <> "" And PrinterPort <> "" Then
                     SetDefaultPrinter List1.Text, DriverName, PrinterPort
                 End If
             End If
         End Sub
   
         Private Sub Command1_Click()
             Dim osinfo As OSVERSIONINFO
             Dim retvalue As Integer
   
             osinfo.dwOSVersionInfoSize = 148
             osinfo.szCSDVersion = Space$(128)
             retvalue = GetVersionExA(osinfo)
   
         If osinfo.dwMajorVersion = 3 And osinfo.dwMinorVersion = 51 And _
             osinfo.dwBuildNumber = 1057 And osinfo.dwPlatformId = 2 Then
                 Call WinNTSetDefaultPrinter
             ElseIf osinfo.dwMajorVersion = 4 And osinfo.dwMinorVersion = 0 _
             And osinfo.dwBuildNumber = 67109814 And osinfo.dwPlatformId = 1 _
             Then
                 Call Win95SetDefaultPrinter
             ElseIf osinfo.dwMajorVersion = 4 And osinfo.dwMinorVersion = 0 _
             And osinfo.dwBuildNumber = 1381 And osinfo.dwPlatformId = 2 Then
                 Call WinNTSetDefaultPrinter
             End If
         End Sub
   
         Private Sub Form_Load()
             Dim r As Long
             Dim Buffer As String
   
             'Get the list of available printers from WIN.INI
             Buffer = Space(8192)
             r = GetProfileString("PrinterPorts", vbNullString, "", _
                Buffer, Len(Buffer))
   
             'Display the list of printer in the list box List1
             ParseList List1, Buffer
         End Sub
   
   

STATUS

Microsoft has confirmed this to be a bug in the Microsoft products listed at the beginning of this article. This bug has been fixed in Visual Studio 97 Service Pack 2.

For more information on the Visual Studio 97 Service Pack 2, please see the following article in the Microsoft Knowledge Base:

   ARTICLE-ID: Q170365
   TITLE     : INFO: Visual Studio 97 Service Packs - What, Where, and Why

   ARTICLE-ID: Q171554
   TITLE     : INFO: Visual Basic 5.0 Fixes in Visual Studio 97
               Service Pack 2

REFERENCES

For more information, please see the following article in the Microsoft Knowledge Base:

   ARTICLE-ID: Q142388
   TITLE     : Changing WIN.INI Printer Settings from VB using Windows API