Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel Envoyer une feuille par mail

Envoyer une feuille par mail

4 réponses
Avatar
Pascal LASSERRE
Bonjour à tous

Ce sujet a surement était traité mais j'avoue avoir du mal à le retrouver
(Par St Google !!)

Je souhaiterait envoyer une feuille à plusieurs personnes à partir d'un
classeur Excel. Ma macro récupère les destinataires, mets à jour les
données, fait une copie de la feuille active et (là est est le problème)
l'envoie en tant que pièce jointe. Le problème, je souhaiterais l'envoyer
dans le corps de mon mail, comme dans le menu Fichier / Envoyer vers..
Destinataire.

Je suis parti de ce module comme base de travail

Public Sub EnvoiFeuilMail()
Dim Wbk As Workbook
ThisWorkbook.ActiveSheet.Copy
Set Wbk = ActiveWorkbook
SendKeys "{E}"
Wbk.SendMail "email@bob.com", "Bulletin", True
'true pour un avis de reception
Wbk.Close savechanges:=False
Set Wbk = Nothing
End Sub

Un petit coup de pouce, siouplait

Merci d'avance

Pascal
Signaler un problème avec ce contenu

4 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
MichDenis
Tu devrais trouver ce qui te convient là :

http://www.rondebruin.nl/sendmail.htm



"Pascal LASSERRE" a écrit dans le message de news:
45a8cdf3$0$27391$
Bonjour à tous

Ce sujet a surement était traité mais j'avoue avoir du mal à le retrouver
(Par St Google !!)

Je souhaiterait envoyer une feuille à plusieurs personnes à partir d'un
classeur Excel. Ma macro récupère les destinataires, mets à jour les
données, fait une copie de la feuille active et (là est est le problème)
l'envoie en tant que pièce jointe. Le problème, je souhaiterais l'envoyer
dans le corps de mon mail, comme dans le menu Fichier / Envoyer vers..
Destinataire.

Je suis parti de ce module comme base de travail

Public Sub EnvoiFeuilMail()
Dim Wbk As Workbook
ThisWorkbook.ActiveSheet.Copy
Set Wbk = ActiveWorkbook
SendKeys "{E}"
Wbk.SendMail "", "Bulletin", True
'true pour un avis de reception
Wbk.Close savechanges:úlse
Set Wbk = Nothing
End Sub

Un petit coup de pouce, siouplait

Merci d'avance

Pascal
Avatar
Pascal LASSERRE
Excellent lien, j'y ais trouvé mon bonheur.

Il reste tout de même un bémol. Le code que j'utilise est donné plus bas.

Ce que je ne m'explique pas, ce code fonctionne bien, mais a tendance à me
faire planter Excel (Opération non conforme blablabla...)

Même par d'erreur dans VBA, direct planté !

Quelqu'un a une idée ? Je vais continuer à creuser la question

Merci à vous

Public Sub smail()
Dim i As Integer
Dim iMsg As Object
Dim iConf As Object
Dim strbody As String
Set iConf = CreateObject("CDO.Configuration")
Application.ScreenUpdating = False
i = 2
boucle:
Sheets("ects3").Select
Range("A" + Trim(Str(i))).Select
If i = 30 Then GoTo fin '******** On traite que 28 enregistrement pour
test
Set iMsg = CreateObject("CDO.Message")
'****************** Copie des données
Application.CutCopyMode = False
Selection.Copy
Sheets("LGOALS_S3").Select
Range("B1").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=
_
False, Transpose:úlse
'******************
strbody = SheetToHTML(ActiveSheet)

With iMsg
Set .Configuration = iConf
.To =
.CC = ""
.BCC = ""
.From = """Pascal"" "
.subject = "Bulletin envoyé à " + Cells(1, 2)
.HTMLBody = strbody
'.Send
End With
Set iMsg = Nothing
i = i + 1: GoTo boucle
fin:
Set iConf = Nothing
Application.ScreenUpdating = True
End Sub


Public Function SheetToHTML(sh As Worksheet)
'Function from Dick Kusleika his site
'http://www.dicks-clicks.com/excel/sheettohtml.htm
'Changed by Ron de Bruin 19-Aug-2006
Dim TempFile As String
Dim Nwb As Workbook
Dim fso As Object
Dim ts As Object

sh.Copy
Set Nwb = ActiveWorkbook

With Nwb.Sheets(1)
On Error Resume Next
.DrawingObjects.Visible = True
.DrawingObjects.Delete
On Error GoTo 0
End With

TempFile = Environ$("temp") & "/" & _
Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

Nwb.SaveAs TempFile, xlHtml
Nwb.Close False

Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
SheetToHTML = ts.ReadAll
ts.Close

On Error Resume Next
Kill TempFile
fso.deletefolder Left(TempFile, Len(TempFile) - 4) & "*", True
On Error GoTo 0

Set ts = Nothing
Set fso = Nothing
Set Nwb = Nothing
End Function
Avatar
MichDenis
Tu devrais placer cette ligne de code avant le début
de ta boucle.
Set iMsg = CreateObject("CDO.Message")
Car tu as besoin seulement d'une même instance pour
l'ensemble de ta procédure...

Par la suite, tu places ton curseur entre Sub et End Sub de
ta procédure et tu utilises la touche F8 pour faire progresser
pas à pas ta macro. Cela devrait t'indiquer où ta procédure
fait planter Excel.




"Pascal LASSERRE" a écrit dans le message de news:
45a93ebd$0$27371$
Excellent lien, j'y ais trouvé mon bonheur.

Il reste tout de même un bémol. Le code que j'utilise est donné plus bas.

Ce que je ne m'explique pas, ce code fonctionne bien, mais a tendance à me
faire planter Excel (Opération non conforme blablabla...)

Même par d'erreur dans VBA, direct planté !

Quelqu'un a une idée ? Je vais continuer à creuser la question

Merci à vous

Public Sub smail()
Dim i As Integer
Dim iMsg As Object
Dim iConf As Object
Dim strbody As String
Set iConf = CreateObject("CDO.Configuration")
Application.ScreenUpdating = False
i = 2
boucle:
Sheets("ects3").Select
Range("A" + Trim(Str(i))).Select
If i = 30 Then GoTo fin '******** On traite que 28 enregistrement pour
test
Set iMsg = CreateObject("CDO.Message")
'****************** Copie des données
Application.CutCopyMode = False
Selection.Copy
Sheets("LGOALS_S3").Select
Range("B1").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks: _
False, Transpose:úlse
'******************
strbody = SheetToHTML(ActiveSheet)

With iMsg
Set .Configuration = iConf
.To =
.CC = ""
.BCC = ""
.From = """Pascal"" "
.subject = "Bulletin envoyé à " + Cells(1, 2)
.HTMLBody = strbody
'.Send
End With
Set iMsg = Nothing
i = i + 1: GoTo boucle
fin:
Set iConf = Nothing
Application.ScreenUpdating = True
End Sub


Public Function SheetToHTML(sh As Worksheet)
'Function from Dick Kusleika his site
'http://www.dicks-clicks.com/excel/sheettohtml.htm
'Changed by Ron de Bruin 19-Aug-2006
Dim TempFile As String
Dim Nwb As Workbook
Dim fso As Object
Dim ts As Object

sh.Copy
Set Nwb = ActiveWorkbook

With Nwb.Sheets(1)
On Error Resume Next
.DrawingObjects.Visible = True
.DrawingObjects.Delete
On Error GoTo 0
End With

TempFile = Environ$("temp") & "/" & _
Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

Nwb.SaveAs TempFile, xlHtml
Nwb.Close False

Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
SheetToHTML = ts.ReadAll
ts.Close

On Error Resume Next
Kill TempFile
fso.deletefolder Left(TempFile, Len(TempFile) - 4) & "*", True
On Error GoTo 0

Set ts = Nothing
Set fso = Nothing
Set Nwb = Nothing
End Function
Avatar
Pascal LASSERRE
Merci beaucoup pour tes indications.

Le plantage se produisait à l'execution de sh.Copy dans le module
SheetToHTML.

Du coup, j'ai épuré le code de la façon suivante (en fait je ne comprends
pas quel est l'intérêt de copier la feuille courante vers un nouveau
classeur) :

Public Function SheetToHTML(sh As Worksheet)
Dim fbulletin as string
Dim TempFile As String
Dim fso As Object
Dim ts As Object
fbulletin=sh.Name
TempFile = Environ$("temp") & "" & _
Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
'****Sauve au format HTML
ActiveWorkbook.PublishObjects.Add(xlSourceSheet, _
TempFile, fbulletin, "", _
xlHtmlStatic, "", "").Publish (True)
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
SheetToHTML = ts.ReadAll
ts.Close
On Error Resume Next
Kill TempFile
fso.deletefolder Left(TempFile, Len(TempFile) - 4) & "*", True
On Error GoTo 0

Set ts = Nothing
Set fso = Nothing
End Function

Et là, pas de plantage, les mails partent à fond de train. C'est royal.

Voilà, fin de ce petit brainstorming.

Merci de ton aide,

En espérant pouvoir renvoyer l'ascenseur.

Pascal