Changement d'imprimante

Bonjour,

Dans Access 97, j'utilise le code suivant pour changer l'imprimante par
défaut en l'imprimante RightFax Direct pour envoyer un fax.
ayant migré sous ACCESS XP, le code ne fonctionne plus (pourtant pas de
message d'erreur) bien que l'imprimante Rightfax Direct soit toujours sur NE01

Option Compare Database
Option Explicit
Type ljg_Device_Nm
drDeviceName As String
drDriverName As String
drPort As String
End Type

Type ljg_Org_Device_Nm
drDeviceName As String
drDriverName As String
drPort As String
End Type

Const MAX_SIZE = 255
Const MAX_SECTION = 2048

Declare Function bc_api_GetProfileString 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
Declare Function bc_api_WriteProfileString Lib "Kernel32" Alias
"WriteProfileStringA" (ByVal strAppName As String, ByVal strKeyName As
String, ByVal strValue As String) As Integer
Declare Function bc_api_GetProfileSection Lib "Kernel32" Alias
"GetProfileSectionA" (ByVal lpAppName As String, ByVal lpReturnedString As
String, ByVal nSize As Long) As Long


Global int_Dflt As Boolean
Global org_dv As ljg_Org_Device_Nm

Public Function SetPrinterRightFax(Mode As Boolean)
'Défini par défaut l'imprimant RightFax
'Mode True = RightFax
' False = Imprimante par défaut
'
Dim dr As ljg_Device_Nm


Dim dr_Device As String
Dim dr_Driver As String
Dim dr_Port As String
Dim msg_Str As String

dr_Device = "RightFax Direct"
dr_Driver = "RightFax Direct sur Ne01:"
'dr_Driver = "RightFax Fax Printer sur Ne00:"
dr_Port = "S000110FAXB:HPFAX" 'PUB:

If Mode = True Then 'Imprimé vers RightFax
int_Dflt = ljg_GetDefaultPrinter(org_dv)
With dr
.drDeviceName = dr_Device
.drDriverName = dr_Driver
.drPort = dr_Port
End With
If Not ljg_SetDefaultPrinter(dr) Then
MsgBox "Impossible de définir l'imprimante RightFax !", vbInformation,
"RightFax"
End If

Else 'Revient à l'imprimante par défaut

With dr
.drDeviceName = org_dv.drDeviceName
.drDriverName = org_dv.drDriverName
.drPort = org_dv.drPort
End With
If Not ljg_SetDefaultPrinter(dr) Then
MsgBox "Impossible de revenir à l'imprimante par défaut !",
vbInformation, "RightFax"
End If
End If

End Function

Function ljg_GetDefaultPrinter(drv As ljg_Org_Device_Nm) As Boolean

'Accepts: ljg_GetDefaultPrinter(dr)
'Purpose: 1) see if default printer exists
' 2) bring back Device - Driver - Port
'Returns: True/False if default exists
' Device - Driver - Port eq HP LaserJet 4 - HPPCL5MS - Lpt1:

On Error GoTo ljg_GetDefaultPrinter_Err

'----
Dim strBuffer As String


Dim intTmp As Integer
Dim intTmp2 As Integer

Dim intChars As Integer

'---- do api to get default printer

strBuffer = String(MAX_SIZE, 0)
intChars = bc_api_GetProfileString("Windows", "Device", "", strBuffer,
MAX_SIZE)
strBuffer = Left(strBuffer, intChars)

If Len(strBuffer) > 0 Then
'------------------ Pull string apart -------------
intTmp = InStr(1, strBuffer, ",") - 1
drv.drDeviceName = Mid(strBuffer, 1, intTmp)

strBuffer = Mid(strBuffer, intTmp + 2)
intTmp = InStr(1, strBuffer, ",") - 1
drv.drDriverName = Mid(strBuffer, 1, intTmp)


drv.drPort = Mid(strBuffer, intTmp + 2)

ljg_GetDefaultPrinter = True
Else
ljg_GetDefaultPrinter = False
End If

'----
'
ljg_GetDefaultPrinter_Done:
Application.Echo True
Exit Function

ljg_GetDefaultPrinter_Err:
MsgBox Err.Description, vbCritical, "Error " & Err
Resume ljg_GetDefaultPrinter_Done


End Function '----------------------------------

Function ljg_SetDefaultPrinter(dr As ljg_Device_Nm) As Boolean

'Accepts: ljg_SetDefaultPrinter(dr)
'Purpose: Sets the default printer through Windows API
'Returns: True if successful

On Error GoTo ljg_SetDefaultPrinter_Err

'----
Dim strBuffer As String
'----

'-------- Build up the appropriate string.
strBuffer = dr.drDeviceName & ","
strBuffer = strBuffer & dr.drDriverName & ","
strBuffer = strBuffer & dr.drPort


'----------- Now write that string out to WIN.INI.
ljg_SetDefaultPrinter = (bc_api_WriteProfileString("Windows", _
"Device", strBuffer) <> 0)

'----
'
ljg_SetDefaultPrinter_Done:
Application.Echo True
Exit Function

ljg_SetDefaultPrinter_Err:
MsgBox Err.Description, vbCritical, "Error " & Err
Resume ljg_SetDefaultPrinter_Done


End Function '-----------


Merci beaucoup pour votre aide
Dominique