Printers

Again, from My Engineering World, I stomped on this post, dealing with printers. Is not that I do a lot of printing, but sometimes come handy when you need to send to PDF.

I have several other procedures coded in the past that perform these tasks, but decided to try to work on them again, and retailor to better fit as general procedures/functions.

'----------------------------------------------------------------------------------
' Functions to deal with printers from VBA:
'
' • PrinterExists:           Checks if there is a printer installed with the given name.
' • IsDefaultPrinter:        Checks if the given printer corresponds to the default windows printer.
' • SetDefaultPrinter:       Makes the given printer to be the default one.
'
' • SelectPrinter:           Shows the list of installed printers and retrieves one.
'
' • GetInstalledPrinters:    Loops through all the installed printers and outputs to an array.
'                            Moreover, it checks if each printer is the default one.
'
' • SetAsTheDefaultPrinter:  The user selects a printer to becomes the default one.
'----------------------------------------------------------------------------------

Private computer            As String
Private wmiService          As Object
Private installedPrinters   As Object 'Variant
Private printer             As Object

Public Function PrinterExists(ByVal printerName As String) As Boolean
    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 GoTo ExitProc

    '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
            GoTo ExitProc
        End If
    Next printer

ExitProc:
    On Error GoTo 0
End Function

Public Function IsDefaultPrinter(ByVal printerName As String) As Boolean
    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 GoTo ExitProc

    '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

ExitProc:
    On Error GoTo 0
End Function

Public Function SelectPrinter() As String
    Dim aPrinter() As String
    Dim lgPrinter As Long
    Dim strMsg As String

    On Error Resume Next

    aPrinter() = VBA.Split(GetInstalledPrinters, vbCrLf)
    ReDim Preserve aPrinter(LBound(aPrinter) To UBound(aPrinter) - 1)
    strMsg = "Default        PrinterName" & vbCrLf
    For lgPrinter = LBound(aPrinter) + 1 To UBound(aPrinter)
        strMsg = strMsg & lgPrinter & ": " & aPrinter(lgPrinter) & vbCrLf
    Next lgPrinter

    lgPrinter = VBA.CLng(VBA.InputBox("Select printer (0 for default):" & vbCrLf & vbCrLf & strMsg, _
                                      "Select printer", 1))
    If lgPrinter = 0 Then
        GoTo ExitProc
    ElseIf lgPrinter  UBound(aPrinter) Then
        GoTo ExitProc
    Else
        SelectPrinter = VBA.Trim$(VBA.Mid$(VBA.Trim$(aPrinter(lgPrinter)), 2))
    End If

ExitProc:
    On Error GoTo 0
End Function

Public Function SetDefaultPrinter(Optional ByVal printerName As String = vbNullString) As Boolean
    Dim wscNetwork As Object

    On Error Resume Next

    'Check if the printer name is empty.
    'If printerName = vbNullString Then GoTo ExitProc
    If printerName = vbNullString Then
        'Select printer
        printerName = SelectPrinter
    End If

    If Not PrinterExists(printerName) Then
        MsgBox "Printer [" & printerName & "] does not exist. Won't set printer", vbExclamation, "W A R N I N G"
        GoTo ExitProc
    End If

    'Test if the printer is already the default one. If yes, return True.
    If IsDefaultPrinter(printerName) = True Then
        SetDefaultPrinter = True
        GoTo ExitProc
    End If

    'The printer is not the default one. Create the WScript.Network object.
    Set wscNetwork = CreateObject("WScript.Network")

    'If the WScript.Network object was not created, exit.
    If wscNetwork Is Nothing Then GoTo ExitProc

    'Set the given printer to be the default one.
    wscNetwork.SetDefaultPrinter printerName

    'Release the WScript.Network object.
    Set wscNetwork = Nothing

    'Check (again) if after the change, the given printer is indeed the default one.
    SetDefaultPrinter = IsDefaultPrinter(printerName)

ExitProc:
    On Error GoTo 0
End Function

Public Function GetInstalledPrinters() As String
    Dim computer            As String
    Dim wmiService          As Object
    Dim installedPrinters   As Object 'Variant
    Dim printer             As Object
    Dim strPrinters         As String

    On Error Resume Next

    '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"
        GoTo ExitProc
    End If

    'Loop through all the installed printers and get their name.
    'Check if one of them is the default one.
    strPrinters = "Default   PrinterName" & vbCrLf
    For Each printer In installedPrinters
        strPrinters = strPrinters & _
                      VBA.Space(5) & VBA.IIf(printer.Default, "•", "º") & VBA.Space(9) & _
                      printer.Name & vbCrLf
    Next printer

    GetInstalledPrinters = strPrinters

ExitProc:
    On Error GoTo 0
End Function

Public Sub SetAsTheDefaultPrinter()
    Dim printerName As String

    On Error Resume Next

    printerName = SelectPrinter
    Call SetDefaultPrinter(printerName)

ExitProc:
    On Error GoTo 0
End Sub


Public Function CheckPrinterStatus(ByVal strPrinterName As String) As String
' Returns a string with the printer status.

    Dim strComputer As String
    Dim objWMIService As Object
    Dim colInstalledPrinters As Variant
    
    On Error Resume Next
    
    'Set the WMI object and the check the install printers.
    strComputer = "."
    Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
    Set colInstalledPrinters = objWMIService.ExecQuery("Select * from Win32_Printer")
        
    'If an error occurs in the previous step, the function will return error.
    If Err.Number  0 Then
        CheckPrinterStatus = "Error"
        GoTo ExitProc
    End If
    
    'The function loops through all installed printers and for the selected printer,
    'checks it status.
    For Each Printer In colInstalledPrinters
        If Printer.Name = strPrinterName Then
            Select Case Printer.PrinterStatus
                Case 1: CheckPrinterStatus = "Other"
                Case 2: CheckPrinterStatus = "Unknown"
                Case 3: CheckPrinterStatus = "Idle"
                Case 4: CheckPrinterStatus = "Printing"
                Case 5: CheckPrinterStatus = "Warmup"
                Case 6: CheckPrinterStatus = "Stopped printing"
                Case 7: CheckPrinterStatus = "Offline"
                Case Else: CheckPrinterStatus = "Error"
            End Select
        End If
    Next Printer
    
    'If there is a blank status the function returns error.
    If CheckPrinterStatus = "" Then CheckPrinterStatus = "Error"
    
ExitProc:
    On Error GoTo 0
End Function

 

Leave a Reply

Your email address will not be published. Required fields are marked *