Binaryworld - GetDefaultDriverName - Retrieving the default printer Driver name ... [ VB -> Printing ]

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