Change from Set as Default to Set as Active printer

[rjplante]

I have a found a macro online that extracts a list of current available printers. The user can then select one of the printers in the list and execute the second macro to set that printer as the default printer. I like the first part which obtains the list of printers, however, I want the user to select a printer from a drop down list I have in cell L11 to make it the active printer, not the default printer. The end users do not have access to the setting permissions on their terminals to change their default printer, but they can select a different printer to use as the active printer. What code do I need to use to achieve this? my code is listed below.

Function PrinterExists(printerName As String) As Boolean
 
    'Declaring the necessary variables.
    Dim computer            As String
    Dim wmiService          As Object
    Dim installedPrinters   As Variant
    Dim printer             As Object
 
    On Error Resume Next
 
    'Check if the printer name is empty.
    If printerName = vbNullString Then Exit Function
 
    'Set the computer. Dot means the computer running the code.
    computer = "."
 
    'Get the WMI object
    Set wmiService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & computer & "\root\cimv2")
 
    'Retrieve information about the installed printers (by running a query).
    Set installedPrinters = wmiService.ExecQuery("Select * from Win32_Printer")
 
    'If an error occurs in the previous step, the function should exit and return False.
    If Err.Number <> 0 Then Exit Function
 
    'Loop through all the installed printers. If the given name matches to any of the installed printers, exit the loop and return True.
    For Each printer In installedPrinters
        If UCase(printer.Name) = UCase(printerName) Then
            PrinterExists = True
            Exit Function
        End If
    Next printer
 
    On Error GoTo 0
 
End Function
 
Function IsDefaultPrinter(printerName As String) As Boolean
 
    'Declaring the necessary variables.
    Dim computer            As String
    Dim wmiService          As Object
    Dim installedPrinters   As Variant
    Dim printer             As Object
 
    On Error Resume Next
 
    'Check if the printer name is empty.
    If printerName = vbNullString Then Exit Function
 
    'Set the computer. Dot means the computer running the code.
    computer = "."
 
    'Get the WMI object
    Set wmiService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & computer & "\root\cimv2")
 
    'Retrieve information about the installed printers (by running a query).
    Set installedPrinters = wmiService.ExecQuery("Select * from Win32_Printer")
 
    'If an error occurs in the previous step, the function should exit and return False.
    If Err.Number <> 0 Then Exit Function
 
    'Loop through all the installed printers. If the given name matches to any of the installed printers
    'and the Default property is set to True, exit the loop and return True.
    For Each printer In installedPrinters
        If UCase(printer.Name) = UCase(printerName) And printer.Default = True Then
            IsDefaultPrinter = True
            Exit Function
        End If
    Next printer
 
    On Error GoTo 0
 
End Function
 
Function SetDefaultPrinter(printerName As String) As Boolean


    'Declaring the necessary variable.
    Dim wshNetwork As Object
 
    On Error Resume Next
 
    'Check if the printer name is empty.
    If printerName = vbNullString Then Exit Function
 
    'Test if the printer is already the default one. If yes, return True.
    If IsDefaultPrinter(printerName) = True Then
        SetDefaultPrinter = True
        Exit Function
    End If
 
    'The printer is not the default one. Create the WScript.Network object.
    Set wshNetwork = CreateObject("WScript.Network")
 
    'If the WScript.Network object was not created, exit.
    If wshNetwork Is Nothing Then Exit Function
 
    'Set the given printer to be the default one.
    wshNetwork.SetDefaultPrinter printerName
 
    'Release the WScript.Network object.
    Set wshNetwork = Nothing
 
    'Check (again) if after the change, the given printer is indeed the default one.
    SetDefaultPrinter = IsDefaultPrinter(printerName)
 
    On Error GoTo 0
 
End Function


'GET-PRINTER--GET-PRINTER--GET-PRINTER--GET-PRINTER--GET-PRINTER--GET-PRINTER--GET-PRINTER--
'GET-PRINTER--GET-PRINTER--GET-PRINTER--GET-PRINTER--GET-PRINTER--GET-PRINTER--GET-PRINTER--
'GET-PRINTER--GET-PRINTER--GET-PRINTER--GET-PRINTER--GET-PRINTER--GET-PRINTER--GET-PRINTER--
'GET-PRINTER--GET-PRINTER--GET-PRINTER--GET-PRINTER--GET-PRINTER--GET-PRINTER--GET-PRINTER--


Sub GetInstalledPrinters()
 
    'Declaring the necessary variables.
    Dim sht                 As Worksheet
    Dim computer            As String
    Dim wmiService          As Object
    Dim installedPrinters   As Variant
    Dim printer             As Object
    Dim i                   As Integer

If Sheets("Main Page").Range("AW1").Value <> "" Then
    MsgBox "The list of printers aready exists.", vbExclamation, vbOK
    Exit Sub
Else
    Application.ScreenUpdating = False
    Sheets("Printers").Visible = True
       
    On Error Resume Next
 
    'Set the worksheet in which the information will be written.
    Set sht = ThisWorkbook.Worksheets("Printers")
 
    'Check if the sheet exists (there is no error).
    If Err.Number <> 0 Then
        MsgBox "The sheet does not exists!", vbCritical, "Sheet Name Error"
        Exit Sub
    End If
 
    'Clear existing data.
    Call ClearAll
 
    'Set the computer. Dot means the computer running the code.
    computer = "."
 
    'Get the WMI object
    Set wmiService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & computer & "\root\cimv2")
 
    'Retrieve information about the installed printers (by running a query).
    Set installedPrinters = wmiService.ExecQuery("Select * from Win32_Printer")
 
    'If an error occurs in the previous step, inform the user.
    If Err.Number <> 0 Then
        MsgBox "Could not retrieve the printer information from WMI object!", vbCritical, "WMI Object Error"
        Exit Sub
    End If
 
    'Set the starting row.
    i = 2
 
    'Loop through all the installed printers and get their name. Check if one of them is the default one.
    For Each printer In installedPrinters
 
        'Write the results to the worksheet.
        sht.Range("C" & i).Value = printer.Name
        sht.Range("D" & i).Value = printer.Default
        i = i + 1
 
    Next printer
 
    On Error GoTo 0
   
   
    Sheets("Printers").Visible = False
    Sheets("Main Page").Activate
    Sheets("Main Page").Range("AW1").Value = "YES"
   
    '   Notify user to select a printer and press the button
    If Sheets("Main Page").Range("AW2").Value = "" Then
        MsgBox "The printers have been added," & vbCrLf & "please select a printer from the list" & vbCrLf & _
        "and then select the 'Set as Default' button.", vbOKOnly
        Sheets("Main Page").Range("L11").ClearContents
        Sheets("Main Page").Range("L11").Select
        Application.ScreenUpdating = True
    Else
        Application.ScreenUpdating = True
    End If
 End If
 
End Sub


'DEFAULT-DEFAULT-DEFAULT-DEFAULT-DEFAULT-DEFAULT-DEFAULT-DEFAULT-DEFAULT-DEFAULT-
'DEFAULT-DEFAULT-DEFAULT-DEFAULT-DEFAULT-DEFAULT-DEFAULT-DEFAULT-DEFAULT-DEFAULT-
'DEFAULT-DEFAULT-DEFAULT-DEFAULT-DEFAULT-DEFAULT-DEFAULT-DEFAULT-DEFAULT-DEFAULT-
'DEFAULT-DEFAULT-DEFAULT-DEFAULT-DEFAULT-DEFAULT-DEFAULT-DEFAULT-DEFAULT-DEFAULT-


Sub SetAsTheDefaultPrinter()
 
    'Declaring the necessary variable.
    Dim sht     As Worksheet
    Dim rng     As Range
 
    On Error Resume Next
 
    'Set the worksheet in which the information will be written.
    Set sht = ThisWorkbook.Worksheets("Printers")
 
    'Check if the sheet exist (there is no error).
    If Err.Number <> 0 Then
        MsgBox "The sheet does not exists!", vbCritical, "Sheet Name Error"
        Exit Sub
    End If
 
    'Get the intersected range.
    Set rng = Application.Intersect(sht.Range("C2:D26"), Selection.Range("A1"))
 
    'If there is no "common" range, exit.
    If rng Is Nothing Then
        MsgBox "The selected range is outside the 'C2:D26' range!", vbCritical, "Invalid Common Range Error"
        Exit Sub
    End If
 
    'If the common range is empty, exit.
    If IsEmpty(rng) Then
        MsgBox "The range you selected is empty!", vbCritical, "Empty Range Error"
        Exit Sub
    End If
 
    'Check if the selected printer is already the default printer.
    If IsDefaultPrinter(rng.Range("A1")) Then
        MsgBox "The selected printer '" & rng.Range("A1") & "' is already the default printer!", vbExclamation, "Default Printer Warning"
        Exit Sub
    End If
 
    'Finally, set the selected printer as the default one and inform the user.
    If SetDefaultPrinter(rng.Range("A1")) = True Then
 
        'Run the GetInstalledPrinters macro to "prove" the change.
        Call GetInstalledPrinters
 
        'The process succeded.
        MsgBox "The selected printer '" & rng.Range("A1") & "' was set as the default printer!", vbInformation, "Success"
 
    Else
 
        'The process failed.
        MsgBox "It was impossible to set the selected printer '" & rng.Range("A1") & "' as the default printer!", vbCritical, "Failure"
 
    End If
 
Sheets("Printers").Visible = False

End Sub
 
Sub ClearAll()
 
    'Declaring the necessary variable.
    Dim sht As Worksheet
 
    On Error Resume Next
 
    'Set the worksheet in which the information will be written.
    Set sht = ThisWorkbook.Worksheets("Printers")
 
    'Check if the sheet exist (there is no error).
    If Err.Number <> 0 Then
        MsgBox "The sheet does not exists!", vbCritical, "Sheet Name Error"
        Exit Sub
    End If
 
    'Clear the data.
    sht.Range("A2:B26").ClearContents
    sht.Range("A1").ClearContents
   
End Sub

This is what I use to select the desired printer. The cell M1 links to the cell L11 on the main screen to display the selected printer on this worksheet where the printers list is stored. Once the loop has found a match, the set default printer macro from the code block above is run to set it as the default. I just need it to set it as the active printer.

Sub FIND_PRINTER_MATCH()

Sheets("Printers").Visible = True
Sheets("Printers").Activate
    Sheets("Printers").Range("C1").Select
   
    Do
        If ActiveCell.Value = Sheets("Printers").Range("M1").Value Then
            Exit Do
        Else
            ActiveCell.Offset(1, 0).Select
        End If
    Loop

End Sub

 

[NdNoviceHlp]

John_W has some code at this link to set the active printer. HTH. Dave

Set ActivePrinter using VBA

Hi I'm trying to set the active printer using VBA. First I tried this: Sheets(strLocation).PrintOut ActivePrinter:="YRK_Printer on yrkprnt02:", Copies:=1, Collate:=True, _ from:=1, to:=1, IgnorePrintAreas:=False However, when I ran the code, it kept reverting to the default printer. So, I...

www.mrexcel.com