Thread: Printing MSG

Hello Tortus,

Working with printers is not easy if the function doesn't exist. It usually invloves using scripting languages like VBS, WSH, or WMI or the Windows API. In this case I the API because it works Windows '95 through XP. This code hasn't been test on Vista. Copy this code into a Standard VBA Module. Call the macro IsPrinterInstalled to check if a printer is installed on the user's machine. You only need to use the name. The function returns true if the printer is installed, otherwise it will return false. Case is ignored.

'Written: May 04, 2009
'Author: Leith Ross
'Summary: List All Available Local Printers, Printing Services, Faxs, and
'         Remote Networked printers. Works with the following Windows OS: '95, '98,
'         NT, ME, 2000, and XP. Not yet tested on Vista.

Option Explicit

Private Type FILETIME
  dwLowDateTime As Long
  dwHighDateTime As Long
End Type

Private Declare Function RegOpenKeyEx Lib "advapi32.dll" _
    Alias "RegOpenKeyExA" _
     (ByVal hKey As Long, _
      ByVal lpSubKey As String, _
      ByVal ulOptions As Long, _
      ByVal samDesired As Long, phkResult As Long) As Long

Private Declare Function RegEnumKeyEx _
  Lib "advapi32.dll" _
    Alias "RegEnumKeyExA" _
      (ByVal hKey As Long, _
       ByVal dwIndex As Long, _
       ByVal lpName As String, _
       ByRef lpcbName As Long, _
       ByRef lpReserved As Long, _
       ByVal lpClass As String, _
       ByRef lpcbClass As Long, _
       ByRef lpftLastWriteTime As FILETIME) As Long

Private Declare Function RegCloseKey _
  Lib "advapi32.dll" _
    (ByVal hKey As Long) As Long

Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003

Const ERROR_MORE_DATA As Long = 234
Const ERROR_NO_MORE_ITEMS As Long = 259
Const MAX_COUNT As Long = 512
Const NO_ERROR = 0&

Const Synchronize = &H100000
Const STANDARD_RIGHTS_READ = &H20000
Const KEY_QUERY_VALUE = &H1
Const KEY_ENUMERATE_SUB_KEYS = &H8
Const KEY_NOTIFY = &H10
Const KEY_READ = ((STANDARD_RIGHTS_READ Or _
                  KEY_QUERY_VALUE Or _
                  KEY_ENUMERATE_SUB_KEYS Or _
                  KEY_NOTIFY) And _
                  (Not Synchronize))

Private Function GetPrinterNames() As Variant

    Dim Cnt As Long
    Dim FT As FILETIME
    Dim hKey As Long
    Dim KeyLength As Long
    Dim KeyName As String
    Dim KeyRoot As Long
    Dim Printers() As String
    Dim RetVal As Long
    Dim SubKey As String
    Dim SubKeyIndex As Long
    
     'Setup the Hive Key and SubKey to be searched
      KeyRoot = HKEY_LOCAL_MACHINE
      SubKey = "SYSTEM\CurrentControlSet\Control\Print\Printers"
      
     'Open the SubKey
      RetVal = RegOpenKeyEx(KeyRoot, SubKey, 0&, KEY_READ, hKey)
    
      If RetVal <> NO_ERROR Then
         MsgBox "Cannot open key.", , "Search Registry Keys"
      Else
        'Loop to find SubKeys
         SubKeyIndex = 0
           Do
             KeyName = String(MAX_COUNT, 0)
             KeyLength = MAX_COUNT
            
            'Enumerate all the sub keys
             RetVal = RegEnumKeyEx(hKey, SubKeyIndex, KeyName, KeyLength, _
                                   ByVal 0&, vbNullString, 0&, FT)
           
            'Increment the key index
             SubKeyIndex = SubKeyIndex + 1
             
             If RetVal = ERROR_MORE_DATA Then
                MsgBox "Printer Name is to Long.", vbOKOnly + vbExclamation, "Buffer Overflow"
             End If
             
             If RetVal = NO_ERROR Then
               'Expand the Printers array
                ReDim Preserve Printers(Cnt)
               'Save the Printer Name in the array
                Printers(Cnt) = Left(KeyName, KeyLength)
               'Increment the counter
                Cnt = Cnt + 1
             End If
        
          'Keep looking for more keys
           Loop While RetVal <> ERROR_NO_MORE_ITEMS
        
        'Close the Hive Key and SubKey
         RetVal = RegCloseKey(hKey)
      End If
    
    GetPrinterNames = Printers()
    
End Function


Function IsPrinterInstalled(ByVal Printer_Name As String) As Boolean

  Dim I As Long
  Dim PrinterNames As Variant
  Dim Status As Boolean
  
    PrinterNames = GetPrinterNames
    
      For I = LBound(PrinterNames, 1) To UBound(PrinterNames)
        If StrComp(PrinterNames(I), Printer_Name, vbTextCompare) = 0 Then
           Status = True
           Exit For
        End If
      Next I
    
    IsPrinterInstalled = Status
    
End Function