1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61
| Sub EnvoiMailCDO()
Dim mMessage As Object
Dim mConfig As Object
Dim mChps
Set mConfig = CreateObject("CDO.Configuration")
mConfig.Load -1
Set mChps = mConfig.Fields
With mChps
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
'Adapter suivant votre serveur de mail. (exemple pour Gmail.)=> Hotmail "smtp.live.com"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
'En principe, 25 fonctionne avec tout les serveurs.
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
'Vous pouvez essayer sans ces trois lignes
'Mais si votre serveur demande une authentification,
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = "1"
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "adressemail"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "motdepasse"
'Si votre serveur demande une connexion sûre (SSL)
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = "true"
.Update
End With
Set mMessage = CreateObject("CDO.Message")
With mMessage
Set .Configuration = mConfig
.To = "adressemail"
.From = "adressemail"
.Subject = "test"
.TextBody = "Ce mail vous est envoyer pour tester la macros"
'Pour ajouter une pièce jointe, un fichier, classeur, image etc.
'.AddAttachment 'Chemin et nom complet du fichier à joindre
.Send
End With
Set mMessage = Nothing
'Pour un autre message, pas besoin de tout reconfigurer, il faut toutefois recréer un nouveau
'message à chaque fois.
Set mMessage = CreateObject("CDO.Message")
With mMessage
Set .Configuration = mConfig
.To = "adressemail"
.From = "adressemail"
.Subject = "C'est pour le deuxième test d'envoi mail"
.TextBody = "Ce mail vous est envoyer pour tester la macros" & Chr(13) _
& "et voir si le deuxième message est bien passer."
'Pour ajouter une pièce jointe, un fichier, classeur, image etc.
'.AddAttachment 'Chemin et nom complet du fichier à joindre
.Send
End With
Set mMessage = Nothing
'Libère les ressources
Set mConfig = Nothing
Set mChps = Nothing
End Sub |
Partager