XL 2016 Envoie de mail en CDO

Don pépé · 31 Janvier 2017

Bien le bonsoir ou bonjour

je viens vers vous car j'ai un probleme avec l'envoie de mail en cdo ( excel2016)

J'ai une erreur qui s'affiche '80040213' je comprend pas pourquoi

le module de mon envoie de mail :

VB:

Sub EnvoiMailCDO()
Dim mMessage As Object
Dim mConfig As Object
Dim mChps
'Dim FichierMail

    Set mConfig = CreateObject("CDO.Configuration")

    mConfig.Load -1
    Set mChps = mConfig.Fields
    With mChps
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1

        .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "mail" 'Sheets("Configuration").[N4] 'Mail
        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "mdp" 'Sheets("Configuration").[N5] 'Mot de passe
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.serveur.com" 'Sheets("Configuration").[N2] 'Adresse serveur
       
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 'Sheets("Configuration").[N3] 'port
       
        .Update
    End With
   
    'FichierMail = "" 'EMailForm.TextBox5.Value

    Set mMessage = CreateObject("CDO.Message")
    With mMessage
    Set .Configuration = mConfig
        .From = "" 'Sheets("Configuration").[N4]
        .to = "" 'EMailForm.TextBox2.Value
        .Subject = "" & Now 'EMailForm.TextBox3.Value
        .TextBody = "" 'EMailForm.TextBox5.Value
        '.AddAttachment FichierMail
        .Send

    End With
    Set mMessage = Nothing
    Set mConfig = Nothing
    Set mChps = Nothing
End Sub

Merci

Lone-wolf · 4 Février 2017

Bonsoir à tous

Une autre poposition

Dans un 1er module

VB:

Public Const ParamSendUsing As String = "http://schemas.microsoft.com/cdo/configuration/sendusing"
Public Const ParamServeur As String = "http://schemas.microsoft.com/cdo/configuration/smtpserver"
Public Const ParamPort As String = "http://schemas.microsoft.com/cdo/configuration/smtpserverport"
Public Const ParamIdentificateur As String = "http://schemas.microsoft.com/cdo/configuration/smtpauthenticate"
Public Const ParamIdentifiant As String = "http://schemas.microsoft.com/cdo/configuration/sendusername"
Public Const ParamMotDePasse As String = "http://schemas.microsoft.com/cdo/configuration/sendpassword"
Public Const ParamSsl As String = "http://schemas.microsoft.com/cdo/configuration/smtpusessl"

Et dans le module d'envois

VB:

Sub EnvoiMailCDO()
Dim CdoMessage, CdoConfig, CdoParam
Dim Fichier As String
'Pour le serveur outlook.com
'smpt = smtp-mail.outlook.com
'Port = 25 (ou 587 si 25 est bloqué)
'Authentification:  oui
'Connexion chiffrée: TLS
'Pour GMail: smtp.gmail.com

    Fichier = ThisWorkbook.Path & "\Classeur1.xls"
    Set CdoConfig = CreateObject("CDO.Configuration")

    CdoConfig.Load -1
    Set CdoParam = CdoConfig.Fields

    With CdoParam
    .Item(ParamSendUsing) = 2
    .Item(ParamServeur) = "smtp.hotmail.com"    
    .Item(ParamPort) = 25
    .Item(ParamIdentificateur) = "1"
    .Item(ParamIdentifiant) = ""      'Votre Identifiant
    .Item(ParamMotDePasse) = ""   'Votre mot de passe
    .Item(ParamSsl) = "true"
    .Update
    End With

    Set CdoMessage = CreateObject("CDO.Message")
    With CdoMessage
        Set .Configuration = CdoConfig
        .From = ""
        .To = ""
        .CC = "" 'destinataires en copie (CC)
        .BCC = "" 'destinataires en copie cachée (CCI)
        .Subject = "Test Mail CDO"
        .HTMLBody = "<HTML><body><p>Bonjour Messieurs,</p>" _
        & "<p>Veuillez prendre note du fichier en pièce jointe mis à jour.</p>" _
        & PageWeb & "<br><br>" _
        & "<br><br>Cordialement.<br><br><br><br>" _
        & "<p>Tom Tom</p></body><HTML>"
        '& "<center><img src='" & Img & "'></center>" & "<br><br>"
        .AddAttachment (Fichier)
        .Send
    End With
    Set CdoMessage = Nothing
    Set CdoConfig = Nothing
    Set CdoParam = Nothing
End Sub

Dans mon fichier, j'ai mis directement l'identifiant et le mot de passe dans la macro. Sans oublier de cocher la référence Microsoft CDO for Windows...... .

Et Bidochon sans les "" sa me marque une erreur. À tester mais pas sûr

sendusername") = "& identifiant &"

Don pépé · 4 Février 2017

merci a vous sa fonctionne probleme avec mon firewall

XL 2016 Envoie de mail en CDO

Don pépé

XLDnaute Occasionnel

Lone-wolf

XLDnaute Barbatruc

Don pépé

XLDnaute Occasionnel

Discussions similaires