Changing default printer using VB code in Access

[ncsthbell]

Is there a way to change my default printer using vb? I have some reports I want to print to a certain printer and some to a different one. I have a routine that loops through all of the reports to print them so I would like to be able to change the default printer, print the odd reports and then change it back to the default printer after.

I am running Access 2000.

[puppydogbuddy]

try the following code from the tips page of www.aadconsulting.com

Tip and Code Sample: Switching Printers from within your MS Access Application

Fellow Access develepor, Mark Plumpton, of customdata.co.n z, has kindly provided sample code for easily switching printers on the fly while printing Access reports, with code as simple as this...

     SaveDefaultPrinter
     DefaultPrinter = "HP Laserjet (A3)"
     DoCmd.OpenReport "rptTest", acViewNormal
     RestoreDefaultPrinter

Download these demo Access97/2000 databases, which include a class module that performs the function of listing and switching default printers.

http://www.aadconsulting.com/printers.zip

The code is also an excellent example of how you can use classes in your MS Access applications.

[bazam2004]

Hi,

tried your coded class module from printer.zip using ms access 2000. Problem I found is the code doesn't switch printers at all.

When I selected Printer 1 (current default printer) from the list and printed a test page it printed to the default printer (Printer 1) with text saying 'The default printer is: Printer 1)

When I selected Printer 2 from the list of printers (not default) and printed the test page the print job still printed to Printer 1 but the text on the report said the default Printer is Printer 2.

Thus from my observations the code is not switching the default printer from Printer 1 to Printer 2 and then back again.

Is is there a code error or something i'm doing wrong?

[puppydogbuddy]

Post the class module and the code you used to call the class module, so that I can take a look at it.

[bazam2004]

Class Module as Below:

'============== =============== =============== =============== =============== =============== ==========
' Source Module : cdsPrinters
'============== =============== =============== =============== =============== =============== ==========
' Date Created : 21/03/2005
' Author : Mark Plumpton
' Copyright : ©Custom Data Solutions Ltd, 2005. All rights reserved.
' You may use this code in any project so long as you retain this notice.
' Please send any comments to code@customdata .co.nz
' I didn't figure out how to decipher the API calls, but the rest of code is mine.
'============== =============== =============== =============== =============== =============== ==========
'
'============== =============== =============== =============== =============== =============== ==========
' Revision History:
'---------------------------------------------------------------------------------------------------
' Date | Programmer | Comments |
'---------------------------------------------------------------------------------------------------
'
'============== =============== =============== =============== =============== =============== ==========
'
Option Explicit
Option Compare Database

Declare Function GetProfileStrin g Lib "kernel32" Alias "GetProfileStri ngA" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal strReturnedStri ng As String, ByVal nSize As Long) As Long
Declare Function GetProfileSecti on Lib "kernel32" Alias "GetProfileSect ionA" (ByVal lpAppName As String, ByVal strReturnedStri ng As String, ByVal nSize As Long) As Long
Declare Function WriteProfileSec tion Lib "kernel32" Alias "WriteProfileSe ctionA" (ByVal lpAppName As String, ByVal lpString As String) As Long
Declare Function WriteProfileStr ing Lib "kernel32" Alias "WriteProfileSt ringA" (ByVal lpszSection As String, ByVal lpszKeyName As String, ByVal lpszString As String) As Long

Private mstrDefaultPrin ter_User As String

Public Function RestoreDefaultP rinter()
DefaultPrinter = mstrDefaultPrin ter_User
mstrDefaultPrin ter_User = ""
End Function

Public Function SaveDefaultPrin ter()
If mstrDefaultPrin ter_User = "" Then
mstrDefaultPrin ter_User = DefaultPrinter
End If
End Function

Public Property Let DefaultPrinter( strPrinterName As String)
Dim strReturn As String
Dim strPrinterFull As String

'Check for empty string or Null
If strPrinterName <> "" Then

strReturn = String(1000, " ")
GetProfileSecti on "Devices", strReturn, Len(strReturn)
strReturn = Trim(strReturn)

If InStr(1, strReturn, strPrinterName & "=") > 0 Then
strPrinterFull = GetField(strRet urn, strPrinterName & "=", 2)
strPrinterFull = GetField(strPri nterFull, Chr(0), 1)
strPrinterFull = strPrinterName & "," & strPrinterFull
'Set the default printer in the win.ini file, application name = [windows], key name = device
WriteProfileStr ing "windows", "device", strPrinterFull
Else
Err.Raise 1000, , "Printer does not exist in win.ini: " & strPrinterName
End If

End If

End Property

Public Property Get DefaultPrinter( ) As String
Dim strReturn As String

On Error GoTo ErrHere

strReturn = String(100, " ")

GetProfileStrin g "windows", "device", "", strReturn, Len(strReturn)

If InStr(1, strReturn, ",") > 1 Then
strReturn = Left(strReturn, InStr(1, strReturn, ",") - 1)
Else
strReturn = ""
End If

DefaultPrinter = strReturn

ExitHere:
Exit Property

ErrHere:
MsgBox "Error " & Err & ": " & Err.Description
Resume ExitHere
Resume
End Property

Public Function PrinterList() As String
Dim strReturn As String

Dim i As Long
Dim c As String
Dim strPrinterName As String
Dim strCodePort As String 'this only here for completion, not used
Dim intPart As Integer
Dim strTemp As String

On Error GoTo ErrHere

'Initialise the return string
strReturn = String(1000, " ")

'Get the text of Devices section from the win.ini file
GetProfileSecti on "Devices", strReturn, Len(strReturn)
strReturn = Trim(strReturn)

'Parse the printer devices
'Part 1 is the printer name, up to the '=' character
'Part 2 is the printer code and port, upto the ':' character
intPart = 1

For i = 1 To Len(strReturn)
c = Mid(strReturn, i, 1)
Select Case Asc(c)
Case Asc("=")
intPart = 2
Case 0 'Null character
'Once the delimiter has been found the device has been parsed
strTemp = strTemp & strPrinterName & ";"
strPrinterName = ""
strCodePort = ""
intPart = 1
Case Else
Select Case intPart
Case 1 'Build the printer name
strPrinterName = strPrinterName & c
Case 2 'Build the Code and Port description
'this only here for completion, not used
strCodePort = strCodePort & c
End Select
End Select
Next i

strTemp = Left(strTemp, Len(strTemp) - 1)
PrinterList = strTemp

ExitHere:
On Error Resume Next
Exit Function

ErrHere:
MsgBox "Error " & Err & ": " & Err.Description
Resume ExitHere
Resume
End Function

Private Function GetField(ByVal strRecord As String, ByVal strDelimiter As String, ByVal intField As Integer) As String
On Error GoTo ExitHere

Dim blnFoundField As Boolean
Dim intCurrentField As Integer
Dim intPos As Integer
Dim intFinish As Integer

If strRecord <> "" Then
intCurrentField = 1
intPos = 1
blnFoundField = False

While Not blnFoundField
If intCurrentField = intField Then
blnFoundField = True
Else
intPos = Nz(InStr(intPos , strRecord, strDelimiter), 0) + Len(strDelimite r)
Select Case intPos
Case Len(strDelimite r)
blnFoundField = True
Case Else
intCurrentField = intCurrentField + 1
End Select
End If
Wend

If intCurrentField = intField Then
intFinish = InStr(intPos, strRecord, strDelimiter)
If intFinish = 0 Then
intFinish = Len(strRecord) + Len(strDelimite r)
Else
intFinish = intFinish
End If
GetField = Mid(strRecord, intPos, intFinish - intPos)
End If

End If

ExitHere:

End Function



Code that called the module:

Dim strReportName As String
Dim strCriteria As String

SaveDefaultPrin ter
DefaultPrinter = lstPrinter

strReportName = "rptConceptPrin t"
strCriteria = "[NPI_NUMBER]=" & Me![NPI_NUMBER]
DoCmd.OpenRepor t strReportName, acViewNormal, , strCriteria

RestoreDefaultP rinter

DoCmd.Close

[ADezii]

Forgive me for over simplifying, but why not assign each Report its own Default Printer in its Open() Event, then Reset it to the desired Default Printer in the Close() Event of the Report, as in:

Private Sub Report_Open(Cancel As Integer)
Dim prtDefault As Printer

Set Application.Printer = Application.Printers("Microsoft Office Document Image Writer")

Set prtDefault = Application.Printer
End Sub

Private Sub Report_Close()
  Call fResetDefaultPrinter
End Sub

Public Function fResetDefaultPrinter()
Dim prtDefault As Printer

Set Application.Printer = Application.Printers("<Default Printer Name>")

Set prtDefault = Application.Printer
End Function

[DAHMB]

I have all the latest updates and my printer name is correct any other ideas?

[DAHMB]

Ok I got part of it. When I change it to a local printer it works but when I cahnge to a network printer it does not. Any ideas why?

[SixHat]

@puppydoggybudd y Thanks a lot for the great code. It worked perfectly. I had been spinning on this for at least an hour as I had found many examples similar to what @ADezii had posted... but none of them seemed to work for Windows 10.

Your given example smoothly set the new printer and then defaulted back to the original when done. thanks again!