Sorted
I managed to hack together a module to use.
(I hacked apart some .Mdb file on this forum.
I think it was called setprinter97.mdb
modGetDefaultPrinter
________________________________________
Option Compare Database
Option Explicit
Public Declare Function acb_apiGetProfileString Lib "kernel32" Alias "GetProfileStringA" (ByVal strAppName As String, ByVal strKeyName As String, ByVal strDefault As String, ByVal strReturned As String, ByVal lngSize As Long) As Long
Const MAX_SIZE = 255
Const MAX_SECTION = 2048
Type acb_tagDeviceRec
drDeviceName As String
drDriverName As String
drPort As String
End Type
Public Function acbGetINIString(ByVal strGroup As String, ByVal strItem As String) As Variant
' Get a string value from the WIN.INI file. For example,
' the following, in the Immediate Window:
' ? acbGetINIString("Windows", "Device")
'
' might display:
'
' HP LaserJet 4,HPPCL5E,LPT1:
'
Dim intChars As Integer
Dim strBuffer As String
strBuffer = String(MAX_SIZE, 0)
intChars = acb_apiGetProfileString(strGroup, strItem, "", strBuffer, MAX_SIZE)
acbGetINIString = Left(strBuffer, intChars)
End Function
Public Function BuildName(dr As acb_tagDeviceRec) As Variant
' Build up the string in the format:
' HP LaserJet IV on LPT1:
' for display in the combo box.
BuildName = dr.drDeviceName
End Function
Public Function acbGetToken(ByVal strValue As String, ByVal strDelimiter As String, ByVal intPiece As Integer) As Variant
Dim intPos As Integer
Dim intLastPos As Integer
Dim intNewPos As Integer
On Error GoTo HandleErrors
' Make sure the delimiter is just one character.
strDelimiter = Left$(strDelimiter, 1)
' If the delimiter doesn't occur at all, or if
' the user's asked for a negative item, just return the item
' they passed in.
If (InStr(strValue, strDelimiter) = 0) Or (intPiece <= 0) Then
acbGetToken = strValue
Else
intPos = 0
intLastPos = 0
Do While intPiece > 0
intLastPos = intPos
intNewPos = InStr(intPos + 1, strValue, strDelimiter)
If intNewPos > 0 Then
intPos = intNewPos
intPiece = intPiece - 1
Else
' Catch the last piece, where there's no
' trailing token.
intPos = Len(strValue) + 1
Exit Do
End If
Loop
If intPiece > 1 Then
acbGetToken = Null
Else
acbGetToken = Mid$(strValue, intLastPos + 1, intPos - intLastPos - 1)
End If
End If
ExitHere:
Exit Function
HandleErrors:
MsgBox "Error in acbGetToken: " & Error & " (" & Err & ")"
Resume ExitHere
End Function
Function acbGetDefaultPrinter(dr As acb_tagDeviceRec) As Boolean
' Retrieve the default printer information. Though
' the function dutifully returns True if the
' values were available, and False otherwise, Windows
' really isn't happy without a default printer, and
' this situation rarely comes up.
' In:
' dr: a acb_tagDeviceRec structure to fill in
' Out:
' Return Value: True if info available, False otherwise.
' dr: filled in with default printer information,
' if it was available (check the function's return
' value).
'
' Comments:
' Requires the acbGetToken() function from basGetToken
' Requires the acbGetINIString() function from basINIFile
' Requires type definitions from basPrintTypes
Dim strBuffer As String
strBuffer = acbGetINIString("Windows", "Device")
If Len(strBuffer) > 0 Then
With dr
.drDeviceName = acbGetToken(strBuffer, ",", 1)
.drDriverName = acbGetToken(strBuffer, ",", 2)
.drPort = acbGetToken(strBuffer, ",", 3)
End With
acbGetDefaultPrinter = True
Else
acbGetDefaultPrinter = False
End If
End Function
Public Function ReturnDefaultPrinter()
Dim dr As acb_tagDeviceRec
If acbGetDefaultPrinter(dr) Then
ReturnDefaultPrinter = BuildName(dr)
End If
End Function
___________________________________________________
Just use a line such as
lblDefaultPrinter.Caption = ReturnDefaultPrinter
