使用CDO自动发送电子邮件时出错

时间:2013-06-28 08:13:21

标签: email vba excel-vba cdo.message excel

我有一个Excel范围,包括客户的mailto电子邮件地址和到达发票的路径。

我的代码在于向每个mailto地址(来自我的Gmail帐户)发送电子邮件(附发票)。

即使我不包含附件,我也会收到自动化错误。为什么呢?

Sub SendMail()

Dim oCdo As Object
Dim oConf As Object
Dim Flds As Object
Dim strHtml As String  'variable contenu du corps de message
Dim destinataire As String
Dim attachment As String
Dim DerLig

' Définit le contenu du message au format HTML
strHtml = "<HTML><HEAD><BODY>"
strHtml = strHtml & "<center><b> Ceci est un message de test au format <i><Font Color=#ff0000 > HTML. </Font></i></b></center>"
strHtml = strHtml & "</br>Veuillez prendre connaissance de la piece jointe."
strHtml = strHtml & "</BODY></HEAD></HTML>"

DerLig = Range("A" & Rows.Count).End(xlUp).Row
For n = 1 To DerLig
n = n + 1
destinataire = Cells(n, 3).Value
attachement = Cells(n, 8).Value

Set oCdo = CreateObject("cdo.Message")
'Set oConf = CreateObject("cdo.configuration")
'Set Flds = oConf.Fields

With oCdo.configuration.Fields
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com" 'adresse du serveur smtp
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465 'tester 25, 465 ou 587
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True  'Utilise une connection SSL (True or False)
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 40
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1 '0 : pas d'authentification, 1 : authentification basique
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "MY GMAIL" 'identifiant de messagerie
    .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "MY PASSWORD" 'mot de passe de messagerie
    .Update
End With

With oCdo
    .Subject = "Votre facture"                                            ' objet du message
    .From = "MY GMAIL"                                                   ' adresse de l'expéditeur
    .To = destinataire                                                    ' adresse du destinataire
    .BCC = ""                                                             ' en copie cachée pour conserver trace
    .HtmlBody = strHtml                                                   ' corps du message HTML
    '.AddAttachment (attachement)                                         ' ajout de pièce jointe
    .MDNrequested = True
    .Send

End With

Set oCdo = Nothing

Next n

End Sub

1 个答案:

答案 0 :(得分:0)

这是由于以下行:.MDNrequested = True

如果设置为false或缺失,则可以正常工作。

我有同样的问题。在将MDN设置为“True”时,Excel在第一个.send之后重新启动。电子邮件仍然发送,并要求发送“接收反馈”。

BR