Re : Bouton Macro pour envoi mail de formulaire une fois rempli
Bonjour,
JE me greffe au fil, pour une demande complémentaire, je galère pour envoyer en PJ ou dans l'idéal en corps de mail un Fichier HTML , je viens d'essayer en mhtml mais rien ni fait je perds les images (graphiques)
Une idée ?
Ci dessous le code
Sub envoi_FDJ()
' ************** Permet l'envoi par mail de la Feuille de Route du Jour ***********
Dim rngeSend As Range
With Application
On Error Resume Next
' La plage rngesend est definie ici:
Sheets("temp").Select
Set rngeSend = .Range("A1:V130")
' rngeSend Is Nothing lorsque l'utilisateur ne fait aucun choix
If rngeSend Is Nothing Then Exit Sub
On Error GoTo 0
' Exporte la plage vers un fichier de type HTML ceci afin de respecter la mise en page de la plage
.ActiveWorkbook.PublishObjects.Add(4, "E:\Job\Processus SAV GP\DIDR Hebdo TREIN\New RD2\FDJ.mhtml", rngeSend.Parent.Name, rngeSend.Address, 0, "", "").Publish True
' Appelle la routine qui va se charger de créer un mail
' Envoyer le Html en PJ
répertoireappli = ActiveWorkbook.Path
Dim olapp As Outlook.Application
Sheets("Sommaire").Select
Range("C41").Select ' *** Changer le pointage E Mail en fontion Equipe
Dim msg As MailItem
Set olapp = New Outlook.Application
Set msg = olapp.CreateItem(olMailItem)
msg.To = ActiveCell.Value
msg.Subject = Range("D41").Value '*** Changer le pointage Equipe
msg.body = Range("C49").Value & Chr(13) & Chr(13) & Range("C50").Value & Chr(13) & Chr(13)
msg.Attachments.Add Source:=répertoireappli & "\FDJ.mhtml"
msg.Send
' Pour envoyer dans le corps du mail mais probleme avec les images
'Call PrepareOutlookMail("E:\Job\Processus SAV GP\DIDR Hebdo TREIN\New RD2\FDJ.mhtml")
' Le fichier HTML n'est plus nécessaire:
Kill "E:\Job\Processus SAV GP\DIDR Hebdo TREIN\New RD2\FDJ.mhtml"
'Kill "E:\Job\Processus SAV GP\DIDR Hebdo TREIN\New RD2\FDJ_fichiers\*.*"
End With ' With Application
End Sub