Pb d'envoi de mail via CDO

ybezier

XLDnaute Nouveau
Bonjour,

Je souhaite envoyer des mails via VBA et la librairy CDO d'excel.
Sur mon pc fixe, je n'ai aucun souci par contre sur portable, j'ai le message d'erreur suivant :

Erreur d'exécution '-2146644475 (800cce05)'
La partie demandée n' pas été trouvée dans ce message
Et ca plante à partir de la ligne en rouge (.Subject = "envoi exemple" )

Mon code :

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
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "mail.lagoon.nc" '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") = "y*****@*****.nc"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "******"
.Update

End With
.Subject = "envoi exemple" ' objet du message
.From = "*****r@yahoo.fr" ' adresse de l'expéditeur
.To = "*****@yahoo.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 Next

End Sub


J'ai désactivé mon parefeu et autre antivirus, mais rien n'y fait.
J'ai essayé plusieurs macro sur différents forum mais toujours le meme message au meme endroit.

Si quelqu'un a une idée ?
Merci d'avance
YB
 

BrunoM45

XLDnaute Barbatruc
Re : Pb d'envoi de mail via CDO

Bonjour le fil

Le problème ne vient pas de l'objet, mais de l'initialisation du serveur d'envoi des mails

Remplace "mail.lagoon.nc" qui est le serveur POP (celui qui reçoit) par "smtp.lagoon.nc" (celui qui envoi)
Le login doit être celui utilisé pour Outlook par exemple ou pour accès web

A+
 
Dernière édition:

ybezier

XLDnaute Nouveau
Re : Pb d'envoi de mail via CDO

Bonjour,

Merci de vous intéresser à mon problème.
Malheureusement aucune de ces deux solutions ne fonctionnent. J'ai toujours le meme message.
Ce que je ne comprend pas, c'est que sur mon PC fixe en XP et excel 2010 tout fonctionne correctement alors que sur rmon portable en Windows 8.1 et excel 2010 j'ai ce message.

ENCORE MERCI DE VOTRE AIDE
YB
 

Roland_M

XLDnaute Barbatruc
Re : Pb d'envoi de mail via CDO

bonjour

EDIT: mes excuses il y avait une petite erreur !

essayer comme ceci en complétant les paramètres simplement en début du Sub !
ne rien modifier en dessous !

Code:
Private Sub EnvoiCdo()
'===================================================
'             INIT ICI LES PARAMETRES              .
'---------------------------------------------------
'si plusieurs adresses séparer avec un point virgule
AdresExpediteur$ = ""
LesAdresDestinataires$ = "" 'ici une ou plusieurs séparer avec un point virgule
LesAdresDestinatairesCC$ = ""
LesAdresDestinatairesBCC$ = ""
Sujet$ = "ici voir le sujet ......."
Message$ = "ici voir le message ..."
PathFichier$ = "" 'ici chemin et fichier à joindre
'
cdoSendUsingPort = 2
SMTPServeurPort = 25
SMTPServeur$ = "smtp.lagoon.nc" 'exp "smtp.orange.fr"

ID_Connexion$ = "" 'pas obligé selon essai !?
MP_Connexion$ = "" 'pas obligé selon essai !?

'******************************************************



'déclaration tardive sans Ref.CDO (sans aide contextuel)
On Error GoTo ErreurNET: Err.Clear
Dim CdoMsg As Object
Set CdoMsg = CreateObject("cdo.message")

'---------- config SMTPServer
With CdoMsg.Configuration.Fields
  
  'Paramétrage du serveur SMTP externe
  '(en interne inutile, mais souvent erreur"Valeur de configuration SendUsing non valide")
  
  '# le minimum ------
  'Config mode d'envoi:(CdoSendUsingPort(2) externe envoi direct) (CdoSendUsingPickup(1) interne utiliser un dossier local SMTP)
  'Numéro Server Port :(smtpserverport mettre 25(par defaut) 465/587 selon serveur!)
  .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = cdoSendUsingPort
  .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = SMTPServeur$
  If SMTPServeurPort > 0 Then .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = SMTPServeurPort
  '#------------------
  
  ' non obligatore !?
  'Authentification:(0)CdoAnonymous (1)CdoBasic (2)CdoNTLM si le serveur en demande une
    Xauthentiticate = cdoAnonymous: If ID_Connexion$ > "" And MP_Connexion$ > "" Then Xauthenticate = cdoBasic
   .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = Xauthenticate
   .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = ID_Connexion$
   .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = MP_Connexion$

  'Connexion(SSL): True=Utilisation SSL  False=Pas d'utilisation SSL(par défaut) si le serveur en demande une sinon false
  .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = False
  .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 10 'sec délai de connexion
  
  .Update
End With

With CdoMsg
'format police si Ref'Microsoft CDO for windows 2000 library'
If FsiReferenceCdoActive Then
  .MimeFormatted = True
  .GetStream.Charset = cdoISO_8859_15
  .BodyPart.Charset = cdoISO_8859_15
  .BodyPart.ContentTransferEncoding = "base64"
End If
  .From = "<" & AdresExpediteur$ & ">" 'adres.expéditeur
  .To = LesAdresDestinataires$     'adres.destinataire(s)
  .CC = LesAdresDestinatairesCC$   'Cc  (Copie carbone)        on voit toutes les adres
  .BCC = LesAdresDestinatairesBCC$ 'Bcc (Copie carbone cachée) on ne voit pas les adres
  .Subject = Sujet$
  '.HTMLBody = MsgHTMLBody ' < si message html
  .TextBody = Message$ 'sinon corps du message en format brut
   
   If PathFichier$ > "" Then .AddAttachment PathFichier$
  .Send 'envoi
   DoEvents
End With

Set CdoMsg = Nothing
Exit Sub

ErreurNET: 'traite erreur connexion
Msg$ = "Erreur " & Err.Source & "  No " & Err.Number & vbLf & vbLf & Err.Description
T$ = "Envoi Mail: Problème de connexion !?"
MsgBox Msg$, vbCritical, T$, Err.HelpFile, Err.HelpContext
Set CdoMsg = Nothing
On Error GoTo 0: Err.Clear
End Sub

Private Function FsiReferenceCdoActive() As Boolean
Dim I%
FsiReferenceCdoActive = False
For I = 1 To ThisWorkbook.VBProject.References.Count
 If ThisWorkbook.VBProject.References(I).Name = "CDO" Then FsiReferenceCdoActive = True: Exit Function
Next
End Function
 

Pièces jointes

  • ybezier.xlsm
    20.6 KB · Affichages: 85
Dernière édition:

BrunoM45

XLDnaute Barbatruc
Re : Pb d'envoi de mail via CDO

Salut ybezier,

J'ai enfin pu tester ton 1er code sur un portable en W8.1 et Office 2010 et tout ce que je peux dire
c'est que le problème vient de ton paramétrage et ou du lieu d’où tu l'envois
Car le code fonctionne parfaitement sur le smtp de free

Petite question, tu n'essaierais pas du réseau de ton entreprise par hasard ?

A+
 
Haut Bas