GetDefaultDriverName - Retrieving the default printer Driver name

Private Declare Function GetProfileString Lib "kernel32" Alias _
    "GetProfileStringA" (ByVal lpAppName As String, ByVal lpKeyName As String, _
    ByVal lpDefault As String, ByVal lpReturnedString As String, _
    ByVal nSize As Long) As Long
Private Declare Function PrinterProperties Lib "winspool.drv" (ByVal hwnd As _
    Long, ByVal hPrinter As Long) As Long
Private Declare Function SHInvokePrinterCommand Lib "shell32.dll" Alias _
    "SHInvokePrinterCommandA" (ByVal hwnd As Long, _
    ByVal uAction As enPrinterActions, ByVal Buffer1 As String, _
    ByVal Buffer2 As String, ByVal Modal As Long) As Long
Private Declare Function OpenPrinter Lib "winspool.drv" Alias "OpenPrinterA" _
    (ByVal pPrinterName As String, phPrinter As Long, _
    pDefault As PRINTER_DEFAULTS) As Long
Private Declare Function SetPrinter Lib "winspool.drv" Alias "SetPrinterA" _
    (ByVal hPrinter As Long, ByVal Level As Long, pPrinter As Any, _
    ByVal Command As Long) As Long
Private Declare Function GetPrinter Lib "winspool.drv" Alias "GetPrinterA" _
    (ByVal hPrinter As Long, ByVal Level As Long, pPrinter As Any, _
    ByVal cbBuf As Long, pcbNeeded As Long) As Long
Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal _
    lpString1 As String, ByVal lpString2 As Any) As Long
Private Declare Function ClosePrinter Lib "winspool.drv" (ByVal hPrinter As _
    Long) As Long

' *** Constants for DEVMODE structure
Private Const CCHDEVICENAME = 32
Private Const CCHFORMNAME = 32

' *** constants for DesiredAccess member of PRINTER_DEFAULTS
Private Const STANDARD_RIGHTS_REQUIRED = &HF0000
Private Const PRINTER_ACCESS_ADMINISTER = &H4
Private Const PRINTER_ACCESS_USE = &H8
Private Const PRINTER_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or _
    PRINTER_ACCESS_ADMINISTER Or PRINTER_ACCESS_USE)

Private Type DEVMODE
   dmDeviceName         As String * CCHDEVICENAME
   dmSpecVersion        As Long
   dmDriverVersion      As Long
   dmSize               As Long
   dmDriverExtra        As Long
   dmFields             As Long
   dmOrientation        As Long
   dmPageSize           As Long
   dmPaperLength        As Long
   dmPaperWidth         As Long
   dmScale              As Long
   dmCopies             As Long
   dmDefaultSource      As Long
   dmPrintQuality       As Long
   dmColor              As Long
   dmDuplex             As Long
   dmYResolution        As Long
   dmTToption           As Long
   dmCollate            As Long
   dmFormName           As String * CCHFORMNAME
   dmLogPixels          As Long
   dmBitsPerPel         As Long
   dmPelsWidth          As Long
   dmPelsHeight         As Long
   dmDisplayFlags       As Long
   dmDisplayFrequency   As Long
   dmICMMethod          As Long        ' // Windows 95 only
   dmICMIntent          As Long        ' // Windows 95 only
   dmMediaType          As Long        ' // Windows 95 only
   dmDitherType         As Long        ' // Windows 95 only
   dmReserved1          As Long        ' // Windows 95 only
   dmReserved2          As Long        ' // Windows 95 only
End Type

Private Type PRINTER_DEFAULTS
   pDatatype            As Long
   pDevMode             As DEVMODE
   DesiredAccess        As Long
End Type

Private Enum enPrinterActions
   PRINTACTION_OPEN = 0
   PRINTACTION_PROPERTIES = 1
   PRINTACTION_NETINSTALL = 2
   PRINTACTION_NETINSTALLLINK = 3
   PRINTACTION_TESTPAGE = 4
   PRINTACTION_OPENNETPRN = 5
   PRINTACTION_DOCUMENTDEFAULTS = 6
   PRINTACTION_SERVERPROPERTIES = 7
End Enum


' Get the default printer Driver name
' Example: Debug.Print GetDefaultDriverName()

Private Function GetDefaultDriverName() As String
   Dim sTmp As String

   On Error Resume Next

   sTmp = Space$(1000)
   Call GetProfileString("windows", "Device", vbNullString, sTmp, 1000)
   sTmp = Replace(sTmp, Chr$(0), vbNullString)
   sTmp = Trim$(sTmp)
   If sTmp = vbNullString Then
      sTmp = Printer.DriverName
   Else
      sTmp = GetToken(sTmp, ",", 1)
   End If
   If sTmp = vbNullString Then
      sTmp = Printer.DriverName
   End If

   GetDefaultDriverName = sTmp
End Function




' This function returns the nToken sToken in a string
' Example:
'   Debug.Print GetToken("This is a test.", " ", 2) ' => "is"

Private Function GetToken(sSearchIn As String, sToken As String, _
    nToken As Long) As String
   Dim nI As Long
   Dim nJ As Long
   Dim nK As Long

   If nToken < 1 Then
      GetToken = vbNullString
      Exit Function
   End If

   nK = 0

   For nI = 1 To nToken
      nJ = nK
      nK = InStr(nJ + 1, sSearchIn, sToken)
      If nK = 0 Then
         If nI = nToken Then
            GetToken = Mid$(sSearchIn, nJ + 1, Len(sSearchIn) - nJ)
         Else
            GetToken = vbNullString
         End If
         Exit Function
      End If
   Next

   GetToken = Mid$(sSearchIn, nJ + 1, nK - nJ - 1)
End Function



'========================================
' You can find more routines like this on www.vbdiamond.com,
'  a site devoted to  VB developers
'========================================