envoi de mail avec CDO

**bertin** · 14/03/2013, 16h41

Bonjour à tous,
Toujours dans ma quête d'envoi de mail à partir d'access 2010 dans un environnement windows 8.
J'ai essayé la métohode CDO
Dans mes références j'ai : Microsoft CDO for Windows 2000 en utilisant cdosys.dll qui se trouve dans c:\windows\SysWOW64

Je n'ai aucun message à la compilation, pas de plantage à l'exécution, mon FAI est orange
La fonction retourne 0 , pas de message à l'exécution mais jamais un mail n'est arrivé dans les boîtes indiquées

Auriez-vous une piste à explorer pour comprendre car là aussi je sèche.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Public Function SendByCdo() As Integer
    On Error GoTo Error_send
 
    Dim oCdo As Object
    Dim strHtml As String  'variable contenu du corps de message
    envoiCdo = 0
    ' 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 pièce jointe."
    strHtml = strHtml & "</BODY></HEAD></HTML>"
 
    Set oCdo = CreateObject("CDO.Message")
 
    With oCdo
        With .Configuration.Fields
            .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2                  'ou cdoSendUsingPort : utilisation réseau
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.orange.fr"    'nom ou IP du serveur SMTP
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = "25"          'port utilisé
 
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
            .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "xxxxxx.xxxxx"
            .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "xxxxxx"
            .Update
        End With
 
        .Subject = "envoi  avec CDO"                    ' objet du message
        .From = "xxxxx.xxxxx@orange.fr"                  ' adresse de l'expéditeur
        .To = "xxxxx.xxxxxx@gmail.com"                  ' adresse du destinataire
        .HTMLBody = strHtml                           ' corps du message HTML
        .BCC = "xxxxx.xxxxx@free.fr"                      ' adresse du destinataire en copie carbone cachée
        .CC = "xxxxx.xxxxx@orange.fr"                        ' adresse du destinataire en copie carbone
        .AddAttachment "D:\02 MySystem\Mes Documents\mois.pdf"   ' lien vers pièce jointe
        .MDNRequested = True                          ' accusé de réception demandé
        .DSNOptions = 2                    ' notification sur échec(2) notification réussite (4) echec/réussite/....(14)
        .Send
    End With
 
Fin:
    Set oCdo = Nothing
    Exit Function
 
Error_send:
    MsgBox "Erreur d'envoi " & err.Number & "  " & err.Description
    Resume Fin
 
End Function

**jimbolion** · 14/03/2013, 18h21

bertin bonjour,

Tu essayeras ce code (j'ai modifié la déclaration de l'objet CDO) et çà fonctionne chez moi :

Tu pourras dès lors si le code suivante remettre tes paramètres d'authentification et voir si cela continue à fonctionner.

Je n'arrive pas à savoir si ton problème vient de la déclaration de l'objet CDO ou de ton authentification (ou autre problème interne).

Ce qui est sûr c'est que cette procédure fonctionne chez moi et te permettra par déduction de déterminer d'où vient le problème.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Public Function SendByCdo() As Integer
    On Error GoTo Error_send
 
    'Dim oCdo As Object
    Dim strHtml As String  'variable contenu du corps de message
    envoiCdo = 0
    ' 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 pièce jointe."
    strHtml = strHtml & "</BODY></HEAD></HTML>"
 
    'Set oCdo = CreateObject("CDO.Message")
    Dim oCdo As New CDO.Message
 
    With oCdo
        With .Configuration.Fields
            .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2                  'ou cdoSendUsingPort : utilisation réseau
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.orange.fr"    'nom ou IP du serveur SMTP
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = "25"          'port utilisé
 
            '.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
            '.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "xxxxxx.xxxxx"
            '.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "xxxxxx"
            .Update
        End With
 
        .Subject = "envoi  avec CDO"                    ' objet du message
        .From = "xxxx@gmail.com"                  ' adresse de l'expéditeur
        .To = "xxxxx@gmail.com"                  ' adresse du destinataire
        .HTMLBody = strHtml                           ' corps du message HTML
        .BCC = "xxxxx.xxxxx@free.fr"                      ' adresse du destinataire en copie carbone cachée
        .CC = "xxxxx.xxxxx@orange.fr"                        ' adresse du destinataire en copie carbone
        .AddAttachment "C:\xxxx.jpg"   ' lien vers pièce jointe
        '.MDNRequested = True                          ' accusé de réception demandé
        '.DSNOptions = 2                    ' notification sur échec(2) notification réussite (4) echec/réussite/....(14)
        .Send
    End With
 
Fin:
    Set oCdo = Nothing
    Exit Function

JimBoLion

**bertin** · 15/03/2013, 08h36

Envoyé par jimbolion

bertin bonjour,

Tu essayeras ce code (j'ai modifié la déclaration de l'objet CDO) et çà fonctionne chez moi :

Tu pourras dès lors si le code suivante remettre tes paramètres d'authentification et voir si cela continue à fonctionner.

Je n'arrive pas à savoir si ton problème vient de la déclaration de l'objet CDO ou de ton authentification (ou autre problème interne).

Ce qui est sûr c'est que cette procédure fonctionne chez moi et te permettra par déduction de déterminer d'où vient le problème.

Super je te remercie.
Cela vient de la déclaration et de la création du message CDO.
Cela passe avec ou sans les identifiants d'orange, étonnant je croyais qu'ils étaient obligatoire !
Cela passe avec ou sans la pièce jointe.

Question subsidiaire : peut-on récupérer une info en retour de l'envoi du mail ?

Bonne journée

**tAKAmAkA** · 16/03/2013, 14h46

Bonjour,

Pour ma part la fct me renvoie un string dans lequel je mets soit un message disant que c'est ok, soit le message d'erreur.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Public Function fctSendMailCDO(sExpediteur As String, sDestinataire As String, _
 sObjetMessage As String, sCorpsMessage As String, Optional sPieceJointe As String) As String
Dim Cdo_Message As New CDO.message
On Error GoTo Err_fctSendMailCDO
Set Cdo_Message.Configuration = GetSMTPServerConfig()
With Cdo_Message
    .To = sDestinataire
    .From = sExpediteur
    .Subject = sObjetMessage
    .TextBody = sCorpsMessage
    If Len(sPieceJointe & "") > 0 Then
        .AddAttachment sPieceJointe
    End If
    .Send
End With
 
Set Cdo_Message = Nothing
fctSendMailCDO = "CDO ok : " & sDestinataire & " " & sObjetMessage
Exit_fctSendMailCDO:
    Exit Function
Err_fctSendMailCDO:
    'MsgBox "Erreur basEnvoiEmailCdo_fctSendMailCDO n°: " & err.Number & vbCrLf & err.Description, , "ANAsoft DocuProd"
    fctSendMailCDO = "Erreur basEnvoiEmailCdo n°: " & err.Number & vbCrLf & err.Description
    Resume Exit_fctSendMailCDO
 
End Function

envoi de mail avec CDO [AC-2010]

VBA Access

Discussions similaires

Partager

Partager