OVH Cloud OVH Cloud

envoyer un email avec CDO

3 réponses
Avatar
Philippe Pons
Bonjour,

je teste cette fonctionnalité avec le bout de code que m'a transmis
michdenis hier.
J'ai référencé toutes le librairies relatives à CDO.
OS Win2000Pro
L'exécution de passe bien
Mais je ne reçoit pas le mail envoyé(si il a été envoyé, ce que je ne sait
pas vérifier!)

Si qqu'un à une idée pour faire fonctionner ça, merci d'avance

Philippe

le code:

Public Sub sendMailCDO()
Dim message As Object
Set message = CreateObject("CDO.message")
With message
.To = "monadresse@free.fr"
.From = "monadresse@free.fr"
.Subject = "Test mail CDO"
.TextBody = " Test envoi email avec CDO"
.Send
End With
End Sub

3 réponses

Avatar
Philippe
Bonjour Philippe,

Comme je ne connais pas CDO, je vais tenter de t'aider en te fournissant
deux méthodes d'envoi : Outlook et Lotus :

1/ Outlook

Dim ol As New Outlook.Application
Dim olmail As MailItem

Set ol = New Outlook.Application
Set olmail = ol.CreateItem(olMailItem)

With olmail
.To = ""
.CC = ";"
.Subject = "MONSUJETTEST"
.Body = "MONTEXTE"
.Display
End With

(Le .Dispaly te permet de ne pas l'envoyer directement, mîs tu peux utiliser
. send)

2/ Lotus
Set oSess = CreateObject("Notes.NotesSession")
Set oDB = oSess.GETDATABASE("", "")
Call oDB.OPENMAIL
flag = True
If Not (oDB.IsOpen) Then flag = oDB.Open("", "")

If Not flag Then
MsgBox "Ne peut pas ouvrir le fichier : " & oDB.SERVER &
" " & oDB.FilePath
GoTo exit_SendAttachment
End If

Set oDoc = oDB.CREATEDOCUMENT
Set oItem = oDoc.CREATERICHTEXTITEM("BODY")
oDoc.Form = "Memo"
oDoc.Subject = MySujet
oDoc.sendto = ""
oDoc.CopyTo = ""
oDoc.body = "messagedetest"
oDoc.postdate = Date

'Attache piece jointe

'Call oItem.EmbedObject(1454, "", "c:toto.txt')
oDoc.visable = True

'Envoie le message

oDoc.SEND False

exit_SendAttachment:
On Error Resume Next
Set oSess = Nothing
Set oDB = Nothing
Set oDoc = Nothing
Set oItem = Nothing


A mon avis, l'exemple lotus est plus représentatif. Par contre et par
expérience, si :
- lotus est fermé
- lotus déclenche une erreur quelconque (plus de place, email pas trouvé
dans la liste, ...)
=> l'email ne sera pas envoyé

Si ces exeples t'aident, tant mieux.

Bon courage.



Bonjour,

je teste cette fonctionnalité avec le bout de code que m'a transmis
michdenis hier.
J'ai référencé toutes le librairies relatives à CDO.
OS Win2000Pro
L'exécution de passe bien
Mais je ne reçoit pas le mail envoyé(si il a été envoyé, ce que je ne sait
pas vérifier!)

Si qqu'un à une idée pour faire fonctionner ça, merci d'avance

Philippe

le code:

Public Sub sendMailCDO()
Dim message As Object
Set message = CreateObject("CDO.message")
With message
.To = ""
.From = ""
.Subject = "Test mail CDO"
.TextBody = " Test envoi email avec CDO"
.Send
End With
End Sub





Avatar
michdenis
Bonjour Philippe,

(pourquoi un nouveau fil ? )

CDO n'utilise pas un service de messagerie particulier que ce soit Outlook express ou un autre. En conséquence, il n'inscrit pas
dans Outlook par exemple, les messages qu'il a envoyés. Tu dois conserver la trace des messages envoyés à l'aide d'un ficher texte
que tu te crées.

P.S. Ce n'est pas une bonne idée de cocher des références qui ne sont pas essentielles. Si tu ouvres ton fichier sur un autre
ordinateur, tu pourrais avoir des surprises.

La procédure pourrait devenir :
(pas testé...je te fais confiance ! ;-)

'--------------------------------------------
Private Sub CommandButton1_Click()

Dim Expéditeur As String
Dim Destinataire As String
Dim TCC As String
Dim TBCC As String
Dim Sujet As String
Dim FichierJoint As String
Dim Num As Long

Expéditeur = ""
Destinataire = ""
TCC = ""
TBCC = ""
Sujet = "Il était une fois..."
FichierJoint = "C:MyDirMyFile.xls"

With CreateObject("CDO.Message")
.From = Expéditeur
.To = Destinataire
.CC = TCC
.BCC = TBCC
.Subject = Sujet
.TextBody = "MyMessage"
If FichierJoint <> "" Then
.AddAttachment FichierJoint
End If
.Send
End With

Data = Now & ";" 'Incrit la date et l'heure de l'envoi
Data = Data & Expéditeur & ";"
Data = Data & Destinataire & ";"
Data = Data & TCC & ";"
Data = Data & TBCC & ";"
Data = Data & FichierJoint & ";"
Data = Data & Sujet & ";"

Num = FreeFile
'À définir le chemin et le nom du fichier...
Fichier = "c:CourrierEnvoyé.csv"
Open Fichier For Append As #Num
Print #Num, Data
Close #Num

End Sub
'--------------------------------------------


Salutations!



"Philippe Pons" a écrit dans le message de news: %
Bonjour,

je teste cette fonctionnalité avec le bout de code que m'a transmis
michdenis hier.
J'ai référencé toutes le librairies relatives à CDO.
OS Win2000Pro
L'exécution de passe bien
Mais je ne reçoit pas le mail envoyé(si il a été envoyé, ce que je ne sait
pas vérifier!)

Si qqu'un à une idée pour faire fonctionner ça, merci d'avance

Philippe

le code:

Public Sub sendMailCDO()
Dim message As Object
Set message = CreateObject("CDO.message")
With message
.To = ""
.From = ""
.Subject = "Test mail CDO"
.TextBody = " Test envoi email avec CDO"
.Send
End With
End Sub
Avatar
Philippe Pons
Merci à tous pour vos réponses.
J'ai réussi à envoyer un mail avec CDO, mais à priori il faut lui indiquer
le serveur smtp utilisé.
Comme dans le code ci dessous, récupéré sur le site indiqué dans ce code.

Pour ceux que ça intéresse, une dll qui permet d'outrepasser le security
warning d'outlook est téléchargeable sur le site
http://www.dimastr.com/redemption/ j'ai testé, ça marche, et c'est simple
à mettre en oeuvre

' code extracted from http://www.rondebruin.nl/cdo.htm
Dim iMsg As Object
Dim iConf As Object
Dim strbody As String
Dim Flds As Variant

Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")

iConf.Load -1 ' CDO Source Defaults
Set Flds = iConf.Fields
With Flds

.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2

.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") "smtp.wanadoo.fr" <==mon serveur smtp

.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Update
End With

strbody = "Hi there" & vbNewLine & vbNewLine & _
"This is line 1" & vbNewLine & _
"This is line 2" & vbNewLine & _
"This is line 3" & vbNewLine & _
"This is line 4"

With iMsg
Set .Configuration = iConf
.To = ""
.CC = ""
.BCC = ""
.From = ""
.subject = "Important message"
.TextBody = strbody
.Send
End With

Set iMsg = Nothing
Set iConf = Nothing
End Sub

"michdenis" a écrit dans le message de
news:
Bonjour Philippe,

(pourquoi un nouveau fil ? )

CDO n'utilise pas un service de messagerie particulier que ce soit Outlook
express ou un autre. En conséquence, il n'inscrit pas

dans Outlook par exemple, les messages qu'il a envoyés. Tu dois conserver
la trace des messages envoyés à l'aide d'un ficher texte

que tu te crées.

P.S. Ce n'est pas une bonne idée de cocher des références qui ne sont pas
essentielles. Si tu ouvres ton fichier sur un autre

ordinateur, tu pourrais avoir des surprises.

La procédure pourrait devenir :
(pas testé...je te fais confiance ! ;-)

'--------------------------------------------
Private Sub CommandButton1_Click()

Dim Expéditeur As String
Dim Destinataire As String
Dim TCC As String
Dim TBCC As String
Dim Sujet As String
Dim FichierJoint As String
Dim Num As Long

Expéditeur = ""
Destinataire = ""
TCC = ""
TBCC = ""
Sujet = "Il était une fois..."
FichierJoint = "C:MyDirMyFile.xls"

With CreateObject("CDO.Message")
.From = Expéditeur
.To = Destinataire
.CC = TCC
.BCC = TBCC
.Subject = Sujet
.TextBody = "MyMessage"
If FichierJoint <> "" Then
.AddAttachment FichierJoint
End If
.Send
End With

Data = Now & ";" 'Incrit la date et l'heure de l'envoi
Data = Data & Expéditeur & ";"
Data = Data & Destinataire & ";"
Data = Data & TCC & ";"
Data = Data & TBCC & ";"
Data = Data & FichierJoint & ";"
Data = Data & Sujet & ";"

Num = FreeFile
'À définir le chemin et le nom du fichier...
Fichier = "c:CourrierEnvoyé.csv"
Open Fichier For Append As #Num
Print #Num, Data
Close #Num

End Sub
'--------------------------------------------


Salutations!



"Philippe Pons" a écrit dans le
message de news: %

Bonjour,

je teste cette fonctionnalité avec le bout de code que m'a transmis
michdenis hier.
J'ai référencé toutes le librairies relatives à CDO.
OS Win2000Pro
L'exécution de passe bien
Mais je ne reçoit pas le mail envoyé(si il a été envoyé, ce que je ne sait
pas vérifier!)

Si qqu'un à une idée pour faire fonctionner ça, merci d'avance

Philippe

le code:

Public Sub sendMailCDO()
Dim message As Object
Set message = CreateObject("CDO.message")
With message
.To = ""
.From = ""
.Subject = "Test mail CDO"
.TextBody = " Test envoi email avec CDO"
.Send
End With
End Sub