Bonjour à tous,

Je reviens vers vous, cette fois pour un problème d'envois de mail par CDO.

Mon but : lors de la saisie par mes clients d'un numéro de licence, je souhaiterais que mon soft me renvoie un certain nombre de renseignements indépendamment du mailer utilisé par celui-ci.

Le très bon tuto de jdgayot: http://http://jdgayot.developpez.com...ewsletter-cdo/ ne me laisse cependant que peu d'espoir quand au paramétrage de cet envoi. Mon premier choix consistait en la méthode proposée au paragraphe VI-A-2-a:
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
Option Compare Database
Option Explicit
 
Private Sub envoiCdo)
    On Error GoTo Error_send
    Dim oCdo As Object
 
    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.free.fr"    'nom ou IP du serveur SMTP
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = "25"          'port utilisé
            .Update
 
        End With
        .Subject = "envoi exemple"                    ' objet du message
        .From = "expediteur@free.fr"                  ' adresse de l'expéditeur
        .To = "destinataire@free.fr"                  ' adresse du destinataire
        .TextBody = "Ceci est un message de test."    ' corps du message en format texte brut
        .Send
 
    End With
 
Fin:
    Set oCdo = Nothing
    Exit Sub
 
Error_send:
    MsgBox "Erreur d'envoi " & Err.Number & "  " & Err.Description
    Resume Fin
 
End Sub
Malheureusement une erreur est systématiquement levée comme ci-après:
Nom : erreur CDO.png Affichages : 1328 Taille : 10,4 Ko
Je précise je pense avoir inclus les bonnes références:
Nom : références.png Affichages : 1270 Taille : 26,7 Ko

Malgré toutes mes tentatives de paramétrages divers et recherches sur le sujet, je ne sors pas de la même erreur .

Mon but serait d'envoyer un mail sans faire référence à un quelconque serveur smtp: ce qui est expliqué au paragraphe
VI-A-4. Variante en utilisant la messagerie du PC
qui décrit la procédure suivante:
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
48
49
50
51
52
53
54
55
56
57
58
59
60
Option Compare Database
Option Explicit
 
Private Sub envoiCdo()
    On Error GoTo Error_send
 
    Dim oCdo As Object
    Dim strHtml As String  'variable contenu du corps de message
 
    ' 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
        GoTo Envoi
 
ConfigSmtp:
        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.free.fr"    'nom ou IP du serveur SMTP
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = "25"          'port utilisé
            .Update
        End With
 
Envoi:
        .Subject = "envoi exemple"                           ' objet du message
        .From = "expediteur@free.fr"                         ' adresse de l'expéditeur
        .To = "destinataire@free.fr"                         ' adresse du destinataire
        .HtmlBody = strHtml                                  ' corps du message HTML
        .MDNrequested = True
        .Send
    End With
 
Fin:
    Set oCdo = Nothing
    Exit Sub
 
Error_send:
    If Err.Number = -2147220960 Then
        Select Case MsgBox("Une erreur est survenue lors du transfert sur votre messagerie." _
                           & vbCrLf & "Voulez-vous envoyer votre message directement ?" _
                           , vbOKCancel Or vbExclamation Or vbDefaultButton1, "Erreur")
 
        Case vbOK
            ' Si réponse OK : on passe sur la configuration SMTP.
            GoTo ConfigSmtp
        Case vbCancel
            ' Si réponse Non : on abandonne.
            GoTo Fin
        End Select
    Else
        MsgBox "Erreur d'envoi " & Err.Number & "  " & Err.Description
        Resume Fin
    End If
 
End Sub
Qui me lève l'erreur suivante (après avoir bien sûr adapté le code à mes besoins concernant le destinataire) :
Nom : erreur CDO time out.png Affichages : 1248 Taille : 11,0 Ko


Je ne vois pas de solution pour l'instant, si une bonne âme pouvait me conseiller...

Merci d'avance de vos réponses