Bonjour,
Après plusieurs recherches et étant toujours coincé dans ma macro, je me tourne vers vous.
Je souhaiterai automatiser l'envoi d'un mail sous IBM Lotus Notes. Jusque là rien de bien compliqué, mon code ci-dessous fonctionne bien (il créer un format du mail en binaire).
Dim envoyerA As String, envoyerCc As String, Subject As String
' Indiquer ici l'adresse mail à laquelle il faut envoyer le message :
envoyerA = "xxxx@xxx.xx"
' Indiquer ici le sujet de l'e-mail :
Subject = "Test"
Dim s As Object
Dim docMail As Object
Dim body As Object
Dim stream As Object
Dim att As Object
Set s = CreateObject("Notes.NotesSession")
Set Db = s.CurrentDatabase
s.ConvertMIME = False
'création du mail
Set docMail = Db.CreateDocument
With docMail
.Form = "Memo"
.SendTo = envoyerA
.Subject = Subject
.From = s.COMMONUSERNAME
End With
Set stream = s.CreateStream
Set body = docMail.CreateMIMEEntity
Call stream.writeText("Bonjour,<br /><br /> Blablabla")
Call body.SetContentFromText(stream, "text/html;charset=iso-8859-1", ENC_IDENTITY_8BIT)
Call docMail.SEND(False)
Set docMail = Nothing
Set body = Nothing
Set stream = Nothing
Je souhaiterai donc ajouter une image dans le corps du texte ainsi qu'y joindre un fichier excel.
J'ai fais plusieurs recherche sur internet mais je n'arrive pas à trouver le bon code...
Merci d'avance pour votre aide.
A voir également:
Joindre un fichier et coller une image dans un mail en vba
Voici un exemple d'envoie avec 2 pièces jointes:
Image et classeur.
A adapter:
'Après avoir ajouté la référence "Microsoft CDO for Windows 2000 Library" dans l'éditeur VBA Outils- Références
Sub mail_en_direct()
Const cdoBasic = 1
Dim admail As String, i As Integer
Dim messmail As String, secours As String
Dim expediteur As String
Dim Fichier As Variant
Dim chemin As Variant
Fichier = Application.GetOpenFilename("Fichiers Image (*.jpg), *.jpg")
chemin = Application.GetOpenFilename("Classeurs Excel (*.xls), *.xls")
expediteur = InputBox("Adresse mail de l'Expéditeur", "ADRESSE ELECTRONIQUE", "monadresse@mail.fr")
admail = InputBox("Adresse mail du destinataire", "DESTINATAIRE", "adressedest@mail.fr")
messmail = "Bonjour,"
With CreateObject("CDO.Message")
If Err Then
secours = MsgBox("Problème de CDO non installé sur le serveur")
Exit Sub
Else
.From = expediteur
.To = admail 'destinataire
'.Bcc = ""
.Subject = "Bonjour"
.TextBody = messmail
.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdoBasic
.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = expediteur
.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "ton passeport windows live mail"
.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.free.fr" 'attention mettre votre adresse messagerie
.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Configuration.Fields.Update
.AddAttachment Fichier 'chemin image jointe
.AddAttachment chemin 'chemin classeur joint
.Send
If Err Then MsgBox "Le message n'a pas pu être expédié.Fermez et réessayez."
End If
On Error GoTo 0
End With
MsgBox "Message envoyé avec pièces jointes"
End Sub
La macro bug sur le .Send. J'imagine que c'est à cause du serveur de messagerie que je n'arrive pas à trouver dans mon entreprise... Comment puis-je le trouver ?
De plus j'ai essayé d'adapter votre code au mien mais il ne marche pas non plus. Sauriez-vous pourquoi?
Dim envoyerA As String, envoyerCc As String, Subject As String
' Indiquer ici l'adresse mail à laquelle il faut envoyer le message :
envoyerA = "xxxx@xxx.xx"
' Indiquer ici le sujet de l'e-mail :
Subject = "Test"
Dim s As Object
Dim docMail As Object
Dim body As Object
Dim stream As Object
Dim att As Object
Set s = CreateObject("Notes.NotesSession")
Set Db = s.CurrentDatabase
s.ConvertMIME = False
'création du mail
Set docMail = Db.CreateDocument
With docMail
.Form = "Memo"
.SendTo = envoyerA
.Subject = Subject
.From = s.COMMONUSERNAME
End With
Set stream = s.CreateStream
Set body = docMail.CreateMIMEEntity
Call stream.writeText("Bonjour,<br /><br /> Blablabla")
Sub envoimail()
Dim envoyerA As String, envoyerCc As String, Subject As String
' Indiquer ici l'adresse mail à laquelle il faut envoyer le message :
envoyerA = "xxxx@xxx.xx"
' Indiquer ici le sujet de l'e-mail :
Subject = "Test"
Dim s As Object
Dim docMail As Object
Dim body As Object
Dim stream As Object
Dim att As Object
Dim Fichier As Variant
Dim chemin As Variant
Set s = CreateObject("Notes.NotesSession")
Set Db = s.CurrentDatabase
s.ConvertMIME = False
Fichier = Application.GetOpenFilename("Fichiers Image (*.jpg), *.jpg")
chemin = Application.GetOpenFilename("Classeurs Excel (*.xlsx), *.xlsx")
expediteur = InputBox("Adresse
'création du mail
Set docMail = Db.CreateDocument
With docMail
.Form = "Memo"
.SendTo = envoyerA
.Subject = Subject
.From = s.COMMONUSERNAME
End With
Set stream = s.CreateStream
Set body = docMail.CreateMIMEEntity
Call stream.writeText("Bonjour,<br /><br /> Blablabla")
Call body.AddAttachment Fichier
Call body.AddAttachment chemin
Call body.SetContentFromText(stream, "text/html;charset=iso-8859-1", ENC_IDENTITY_8BIT)
Call docMail.SEND(False)
Set docMail = Nothing
Set body = Nothing
Set stream = Nothing
End Sub
N'ayant pas Lotus Notes, je ne peux donc pas essayer. Je pensais que BDLM ayant résolu son problème, cela aurait pu être de même pour toi.
Désolé, je ne peux pas faire plus
Bon courage
Merci pour votre réponse.
La macro bug sur le .Send. J'imagine que c'est à cause du serveur de messagerie que je n'arrive pas à trouver dans mon entreprise... Comment puis-je le trouver ?
De plus j'ai essayé d'adapter votre code au mien mais il ne marche pas non plus. Sauriez-vous pourquoi?
Dim envoyerA As String, envoyerCc As String, Subject As String
' Indiquer ici l'adresse mail à laquelle il faut envoyer le message :
envoyerA = "xxxx@xxx.xx"
' Indiquer ici le sujet de l'e-mail :
Subject = "Test"
Dim s As Object
Dim docMail As Object
Dim body As Object
Dim stream As Object
Dim att As Object
Set s = CreateObject("Notes.NotesSession")
Set Db = s.CurrentDatabase
s.ConvertMIME = False
'création du mail
Set docMail = Db.CreateDocument
With docMail
.Form = "Memo"
.SendTo = envoyerA
.Subject = Subject
.From = s.COMMONUSERNAME
End With
Set stream = s.CreateStream
Set body = docMail.CreateMIMEEntity
Call stream.writeText("Bonjour,<br /><br /> Blablabla")
Call body.AddAttachment("J:\maphoto.jpg") 'bug ici
Call body.AddAttachment("J:\mon fichier.xlsx")
Call body.SetContentFromText(stream, "text/html;charset=iso-8859-1", ENC_IDENTITY_8BIT)
Call docMail.SEND(False)
Set docMail = Nothing
Set body = Nothing
Set stream = Nothing