Sub envoigmail()
Const cdoSendUsingPickup = 1 [COLOR="green"]'Send message using the local SMTP service pickup directory.[/COLOR]
Const cdoSendUsingPort = 2 [COLOR="green"]'Send the message using the network (SMTP over the network).[/COLOR]
Const cdoAnonymous = 0 'Do not authenticate
Const cdoBasic = 1 'basic (clear-text) authentication
Const cdoNTLM = 2 'NTLM
Dim statut As Boolean
Dim destinataires As String
Dim sujet As String
Dim corps As String
reponse = MsgBox("Le mail sera directement envoyé. Etes-vous sûr de vouloir continuer ?", vbOKCancel + vbExclamation, "Avertissement")
If reponse = vbOK Then
Else
Exit Sub
End If
destinataires = Range("Feuil2!b11").Value
expediteur = Range("Feuil2!b23").Value
adresseexpediteur = Range("Feuil2!B26").Value
sujet = Range("Feuil2!b2").Value
corps = Range("Feuil2!b5").Value
On Error GoTo SMTPSendMail_Err
Set objMessage = CreateObject("CDO.Message")
objMessage.Subject = sujet
objMessage.From = expediteur
objMessage.To = destinataires
objMessage.TextBody = corps
If Not IsMissing(pj) Then
objMessage.AddAttachment pj
End If
[COLOR="green"]'==This section provides the configuration information for the remote SMTP server.[/COLOR]
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
[COLOR="green"]'Name or IP of Remote SMTP Server[/COLOR]
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
[COLOR="green"]' Type of authentication, NONE, Basic (Base64 encoded), NTLM[/COLOR]
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = "1"
[COLOR="green"]'Your UserID on the SMTP server[/COLOR]
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusername") = InputBox("Veuillez saisir votre identifiant (imap)")
[COLOR="green"]'Your password on the SMTP server[/COLOR]
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendpassword") = InputBox("Veuillez saisir votre mot de passe gmail (imap)")
[COLOR="green"]'Server port (typically 25)[/COLOR]
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = [COLOR="Purple"]HIDDEN[/COLOR]
[COLOR="green"]'Use SSL for the connection (False or True)[/COLOR]
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
[COLOR="green"]'Connection Timeout in seconds (the maximum time CDO will try to establish a connection to the SMTP server)[/COLOR]
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
objMessage.Configuration.Fields.Update
[COLOR="Green"]'==End remote SMTP server configuration section==[/COLOR]
objMessage.Send
'Next i
succes = MsgBox(nbmessages & " envoyés avec succès !", vbInformation)
Exit Sub
SMTPSendMail_Err:
'Gestion des erreurs
tmp = MsgBox("Erreur lors de l'envoi de votre message." & Chr(10) & "Détails : " & Err.Description, vbCritical)
End Sub