Envoi lotus depuis Excel

Bonjour,

Mon code marche parfaitement pour envoyer un mail Lotus avec pièce jointe à partir d'excel. Mais je souhaiterais que l'envoi ne soit pas automatique, que le mail soit mis en pause pour que je puisse copier-coller un tableau dans le corps du mail.

Est ce possible ?

Quelles sont les autres méthodes possibles ?

Merci pour votre aide

Sub Mail()
 Dim Maildb As Object 
 Dim UserName As String 
 Dim MailDbName As String 
 Dim MailDoc As Object
 Dim AttachME As Object ect
 Dim Session As Object 
 Dim EmbedObj As Object 

        'définition du mail
    Set objNotesField = MailDoc.CREATERICHTEXTITEM("Body")
     With objNotesField
     .AppendText "Bonjour,"
     .AddNewLine 2
    .AppendText "Vous trouverez ci-joint "
    .AddNewLine 2
    .AppendText "Cordialement,"
    .AddNewLine 2
    .AppendText Sheets("xx").Cells(12, 1).Value
    .AddNewLine 3
    End With
    MailDoc.SaveMessageOnSend = SaveIt

    'pièces jointes

    Attachment1 = Sheets("xx").Cells(1, 3).Value & Sheets("xx").Cells(16, 1).Value & ".xlsx"
    If Attachment1 <> "" Then
    Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment1")
    Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", Attachment1, "Attachment1")
    MailDoc.CREATERICHTEXTITEM (Attachment1)
    End If

    Attachment2 = Sheets("xx").Cells(1, 3).Value & Sheets("xx").Cells(17, 1).Value & ".xlsx"
    If Attachment2 <> "" Then
    Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment2")
    Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", Attachment2, "Attachment2")
    MailDoc.CREATERICHTEXTITEM (Attachment2)
    End If

 MailDoc.PostedDate = Now()
 MailDoc.Send 0, Recipient
 'Clean Up
 Set Maildb = Nothing
 Set MailDoc = Nothing
 Set AttachME = Nothing
 Set Session = Nothing
 Set EmbedObj = Nothing

End Sub

Sinon j'ai trouvé ce code ci qui m'irait bien mais je ne sais pas comment joindre en auto des fichiers :

Merci pour votre aide...

Sub code()
 Dim MailAd As String
 Dim Msg As String
 Dim Subj As String
 Dim URLto As String

 Range("P12:Y40").Select 'copie une zone du fichier EXCEL"
 Selection.Copy

 Windows("_mailing.xlsm").Activate

 MailAd = Range("N13") 'adresse mail

 Copie = Range("N13") 'adresse mail pour CC

 Subj = "Points " & " - " & Sheets("xx").Cells(5, 3).Value & " " & Sheets("xx").Cells(6, 3).Value 'Objet du mail avec texte préformaté et sélection d'une cellule

 Msg = Msg & "Bonjour " & ",%0D%0A %0D%0A" 'Message préformaté

 Msg = Msg & "Vous trouverez ci-joint les points à fin " & Sheets("xx").Cells(5, 3).Value & " " & Sheets("xx").Cells(6, 3).Value & "." & ", %0D%0A %0D%0A" 'Message préformaté avec du texte d'une cellule

 Msg = Msg & "Cordialement," & ", %0D%0A %0D%0A" 'Message préformaté avec du texte d'une cellule

 Msg = Msg & Sheets("xx").Cells(12, 14).Value & "." & ", %0D%0A %0D%0A" 'Message préformaté avec du texte d'une cellule

 URLto = "mailto:" & MailAd & "?subject=" & Subj & "&body=" & Msg & "&Cc=" & Copie

 ActiveWorkbook.FollowHyperlink Address:=URLto

End Sub

Salut Mokia !

Je ne maîtrise pas du tout ce genre de choses, je n'ai jamais fait d'envoi de mails par macro, mais si tu veux stopper la macro avant l'envoi je pense que tu peux faire les modifs ci-dessous sur ton 1er code, ainsi tu auras une boite de dialogue qui te demandera si tu veux envoyer le mail, et si tu réponds non la macro se termine sans autre action.

Sub Mail()
 Dim Maildb As Object 
 Dim UserName As String 
 Dim MailDbName As String 
 Dim MailDoc As Object
 Dim AttachME As Object ect
 Dim Session As Object 
 Dim EmbedObj As Object 

        'définition du mail
    Set objNotesField = MailDoc.CREATERICHTEXTITEM("Body")
     With objNotesField
     .AppendText "Bonjour,"
     .AddNewLine 2
    .AppendText "Vous trouverez ci-joint "
    .AddNewLine 2
    .AppendText "Cordialement,"
    .AddNewLine 2
    .AppendText Sheets("xx").Cells(12, 1).Value
    .AddNewLine 3
    End With
    MailDoc.SaveMessageOnSend = SaveIt

    'pièces jointes

    Attachment1 = Sheets("xx").Cells(1, 3).Value & Sheets("xx").Cells(16, 1).Value & ".xlsx"
    If Attachment1 <> "" Then
    Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment1")
    Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", Attachment1, "Attachment1")
    MailDoc.CREATERICHTEXTITEM (Attachment1)
    End If

    Attachment2 = Sheets("xx").Cells(1, 3).Value & Sheets("xx").Cells(17, 1).Value & ".xlsx"
    If Attachment2 <> "" Then
    Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment2")
    Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", Attachment2, "Attachment2")
    MailDoc.CREATERICHTEXTITEM (Attachment2)
    End If

 MailDoc.PostedDate = Now()

'------------------------------------------------------------------
' AJOUT D'UNE MSGBOX POUR SUSPENDRE L'ENVOI DU MAIL 
 If MsgBox("Envoyer le mail maintenant ?", vbYesNo, "Demande de confirmation") = vbNo Then
      GoTo Fin
  End If
'------------------------------------------------------------------

 MailDoc.Send 0, Recipient
 'Clean Up
 Set Maildb = Nothing
 Set MailDoc = Nothing
 Set AttachME = Nothing
 Set Session = Nothing
 Set EmbedObj = Nothing

'------------------------------------------------------------------------
'AJOUT DE L'ETIQUETTE "Fin" QUI DESIGNE L'ENDROIT OU DOIT ALLER LA PROCEDURE EN CAS DE REPONSE "NON"
Fin:
'------------------------------------------------------------------------
End Sub

Cette solution ne marche pas car je ne vois pas le mail quand il se "construit" donc je ne peux pas faire le copier-coller à la main.

Je désespère car je viens d'essayer toutes les solutions que j'ai trouvées sur Internet mais en vain...

J'arrive à mettre des pièces jointes mais pas de tableau dans le corps du mail avec ma 1ère macro, et l'inverse avec la macro ci-dessous.

En fait, dans le fichier joint, je voudrais rajouter en auto des pièces jointes mais je ne sais pas comment faire.

Ensuite je pourrais faire simplement le copier-coller du tableau qui m'intéresse et déclencher l'envoi du mail à la main.

Est ce que quelqu'un a une idée ?

Merci beaucoup

Sub macro()
 Dim MailAd As String
 Dim Msg As String
 Dim Subj As String
 Dim URLto As String

 Range("E12:F22").Select 'copie une zone du fichier EXCEL"
 Selection.Copy

 Windows("_testxx.xlsm").Activate

 MailAd = Range("B8") 'adresse mail

 Copie = Range("B9") & Range("B10") 'adresse mail pour CC

 Subj = "Conclusion" 'objet du mail

 Msg = Msg & "Bonjour " & ",%0D%0A %0D%0A" 'Message préformaté

 Msg = Msg & "Vous trouverez ci-joint le dossier." & ", %0D%0A %0D%0A" 'Message préformaté avec du texte d'une cellule

 Msg = Msg & "Cordialement," & ", %0D%0A %0D%0A" 'Message préformaté avec du texte d'une cellule

 URLto = "mailto:" & MailAd & "?subject=" & Subj & "&body=" & Msg & "&Cc=" & Copie

 ActiveWorkbook.FollowHyperlink Address:=URLto

 End Sub
64testxx.xlsm (20.59 Ko)
Rechercher des sujets similaires à "envoi lotus"