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