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 SubSinon 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 SubSalut 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 SubCette 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