Quelques mots de remerciements seront grandement appréciés.

VB6 - VBA Envoi mail avec l'objet CDO

Auteur lermite222
18/04/2013

Si le PC hôte ne dispose pas de l'application Outlook vous pouvez vous servir de l'objet CDO pour envoyer vos mails.

Le désavantage avec CDO c'est qu'il faut le configurer avec les paramètres de votre serveur, certains hébergeurs comme Gmail nécessitent une authentification (votre mot de passe) et une connexion sécurisée (SSL).

Cette démo implémente tous les paramètres nécessaires.

Sub DEMO_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.)=> Hormail "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]") = "MyMail@gmail.com" 
        .Item("[http://schemas.microsoft.com/cdo/configuration/sendpassword]") = "MyCodePass" 
        '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 
        .From = "MyMail@gmail.com" 
        .To = "LeClient@hotmail.com"
        '.CC = "LeClient2@mémél.com" 'destinataires en copie (CC)
        '.BCC = "MonSuperieurHierarchique@surveillantenchef.fr" 'destinataires en copie cachée (CCI)
        .Subject = "Le sujet du mail" 
        .TextBody = "Ce mail vous est envoyer pour tester la macros de lermite" 
        '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 
        .From = "MyMail@gmail.com" 
        .To = "AutreClient@gmail.com"
        '.CC = "LeClient2@mémél.com" 'destinataires en copie (CC)
        '.BCC = "MonSuperieurHierarchique@surveillantenchef.fr" 'destinataires en copie cachée (CCI) 
        .Subject = "C'est pour le deuxième test d'envoi mail" 
        .TextBody = "Ce mail vous est envoyer pour tester la macros de lermite" & 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

Vous pouvez télécharger un classeur démo (Excel)
Envoi mail avec CDO.xls