Public Sub RoutineEnvoiMailCDO()
On Error Resume Next
Dim cMail As New CDO.Message
If Err Then
M$ = "CDO n'est pas installé !" & vbLf & _
"Vous devez cocher(du côté VB) la référence suivante:" & vbLf & _
"Microsoft CDO for..." & vbLf & _
"probablement: Microsoft CDO for Windows 2000 Library"
MsgBox M$, vbCritical, "Erreur référence"
On Error GoTo 0: Err.Clear
Exit Sub
End If
'INITIALISATION des variables
Application.ScreenUpdating = False
Dim CheminFichier As String
Dim Sujet As String, Message As String
Dim AdresExpediteur As String, AdresDestinataire As String
'
CheminFichier = "????????????????" '<<<
AdresExpediteur = "??????????????" '<<<
AdresDestinataire = "????????????" '<<<
Sujet = "????????????????????????" '<<<
Message = "??????????????????????" '<<<
'envoi directement NET messagerie
On Error GoTo ErreurNET
With cMail
.From = AdresExpediteur '<<<<<<<<<<<<<
.To = AdresDestinataire '<<<<<<<<<<<<<
.Subject = Sujet '<<<<<<<<<<<<<<<<<<<<
.TextBody = Message '<<<<<<<<<<<<<<<<<
.AddAttachment (CheminFichier) '<<<<<<
.Send
End With
'
On Error GoTo 0: Err.Clear
Application.ScreenUpdating = True
Exit Sub
'--------------------------------
ErreurNET:
Msg$ = "Erreur " & Err.Source & " No " & Err.Number & vbLf & vbLf & Err.Description
T$ = "Envoi Mail: Problème de connexion !?"
MsgBox Msg$, vbCritical, T$, Err.HelpFile, Err.HelpContext
On Error GoTo 0: Err.Clear
Application.ScreenUpdating = True
End Sub