Joindre un fichier et coller une image dans un mail en vba

Résolu
BCDLM Messages postés 13 Statut Membre -  
cs_Le Pivert Messages postés 8437 Statut Contributeur -
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.

6 réponses

  1.
    cs_Le Pivert Messages postés 8437 Statut Contributeur 730
     
    Bonjour,

    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

    0
    1. BCDLM Messages postés 13 Statut Membre
       
      Bonjour,

      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
      0
  2. cs_Le Pivert Messages postés 8437 Statut Contributeur 730
     
    Voir cette ligne et corriger l'adresse messagerie

    .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.free.fr" 'attention mettre votre adresse messagerie

    Allez dans votre messagerie:
    Comptes
    Propriétés
    Serveur
    Courrier sortant(SMTP)

    Je suis avec Windows Live Mail
    Pour les entreprises, je ne sais pas!
    0
  3. cs_Le Pivert Messages postés 8437 Statut Contributeur 730
     
    Avec ton code, essaie ceci: 

    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

    0
    1. cs_Le Pivert Messages postés 8437 Statut Contributeur 730
       
      Supprime cela, erreur de copier coller

      expediteur = InputBox("Adresse
      0
    2. BCDLM Messages postés 13 Statut Membre
       
      Bonjour,

      Merci pour le retour.
      Il y avait une erreur syntaxe dût aux parenthèses qu'il manquait. J'ai donc ces deux lignes.

      Call body.AddAttachment(Fichier)
      Call body.AddAttachment(chemin)

      Malheureusement la macro bug sur les deux lignes...
      0
  4. cs_Le Pivert Messages postés 8437 Statut Contributeur 730
     
    J'ai trouvé cette doc, avec fichiers joints, il suffit de l'adapter:

    https://www.vbafin.com/Lotus-Notes-VBA-code.php
    0
    1. BCDLM Messages postés 13 Statut Membre
       
      Merci bien pour la doc, ça a été très utile !

      Voici le code actuel :

      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)

      Set AttachMe = docMail.CreateRichTextItem("C:\Desktop\monfichier.xlsx")
      AttachMe.EmbedObject 1454, "", (""C:\Desktop\monfichier.xlsx"") ', "Attachment"

      Call docMail.SEND(False)
      Set docMail = Nothing
      Set body = Nothing
      Set stream = Nothing
      0

  5. Vous n’avez pas trouvé la réponse que vous recherchez ?

    Posez votre question
  6. xyvyos
     
    Bonjour,

    Dès que j'utilise ces codes, ils me mettent une erreur au niveau de "Set docMail = Db.CreateDocument " !
    (erreur d'execution 91)

    Est ce que quelqu'un sait comment résoudre ce problème ?

    Merci
    0
  7. cs_Le Pivert Messages postés 8437 Statut Contributeur 730
     
    As-tu lu ceci:

    https://www.vbafin.com/Lotus-Notes-VBA-code.php
    0
    1. xyvyos
       
      Oui je l'ai lu et je l'ai bien activé dans les réferences
      0
    3. xyvyos
       
      Ca me mets toujours le même problème au même endroit ...
      Je ne comprends vraiment pas d'où ça peut venir
      0
    4. cs_Le Pivert Messages postés 8437 Statut Contributeur 730
       
      Erreur d'execution "91" signifie que l'objet n'est pas connecté/renseigné ... il est donc vide

      Cela concerne ces 2 lignes:

      Set s = CreateObject("Notes.NotesSession")
      Set Db = s.CurrentDatabase

      essaie d'ajouter dans les déclarations ceci:

      Dim Db As Object
      0
    5. xyvyos > cs_Le Pivert Messages postés 8437 Statut Contributeur
       
      Je viens de le faire et ça marche toujours pas
      0

Discussions similaires

question pix mot caché
aorum10 -
pixlagalere -

7 réponses