Mail Envoi dans corps mail

Bonjour,

Je souhaite envoyer une feuille Excel dans le corps du mail directement.

J'ai déjà une autre macro mais cela l'envoi en pièce jointe(pdf).

Exemple

Sub ENVOI()
If MsgBox("Etes-vous certain de vouloir envoyer l'offre?", vbYesNo, "Demande de confirmation") = vbYes Then

Dim sh
Dim wb As Worksheet
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim TempFilePath As String
Dim TempFileName As String
Dim iMsg As Object
Dim iConf As Object
Dim Flds As Variant

TempFilePath = Environ$("temp") & "\"

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

Set iConf = CreateObject("CDO.Configuration")

Set sh = ActiveSheet
If sh.Range("e1").Value Like "?*@?*.?*" Then

Set wb = ActiveSheet

'Change all cells in the activesheet to values if you want
' With wb.Sheets(1).UsedRange
' .Cells.Copy
' .Cells.PasteSpecial xlPasteValues
' .Cells(1).Select
' End With
Application.CutCopyMode = False
sh.Select
sh.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
TempFilePath & sh.Name & ".pdf"

'With wb
' .SaveAs TempFilePath & sh.Name & ".pdf"
' .Close savechanges:=False
'End With

Set iMsg = CreateObject("CDO.Message")
With iMsg
.Configuration.Fields.Item _
(a noter)
.Configuration.Fields.Item _
(a noter)
.Configuration.Fields.Item _
(a noter)

.Configuration.Fields.Update
.To = sh.Range("e1").Value
.From = "adresse mail"
.Subject = "Offre de Dégagement ACLV : " & sh.Range("d18").Value
.AddAttachment TempFilePath & sh.Name & ".pdf"
.TextBody = "Bonjour,"
.Send
End With
Set iMsg = Nothing

Kill TempFilePath & sh.Name & ".pdf"

End If

Set iConf = Nothing
Set Flds = Nothing

With Application
.ScreenUpdating = True
.EnableEvents = True
End With

MsgBox "L'offre a bien été envoyée !"
End If
End Sub

Edit modo : Merci de mettre le code entre balises [CODE] [/ CODE] ou avec le bouton </>

Pouvez vous svp m'expliquer

Je vous remercie

Bonjour,

Je suis toujours bloqué. Il y a t-il une solution ou je dois abandonner?

Je vous remercie par avance

Bonjour Camsav

A part le fait que la méthode CDO n'est pas forcément supportée en entreprise, voici le code modifié

Sub ENVOI()
    Dim Sh As Worksheet
    Dim TempFilePath As String
    Dim sPathFic
    Dim iMsg As Object
    Dim iConf As Object
    Dim Flds As Variant

    If MsgBox("Etes-vous certain de vouloir envoyer l'offre?", vbYesNo, "Demande de confirmation") = vbNo Then Exit Sub
    ' Si OUI
    TempFilePath = Environ$("temp") & "\"
    With Application
      .ScreenUpdating = False
      .EnableEvents = False
    End With
    Set iConf = CreateObject("CDO.Configuration")

    Set Sh = ActiveSheet  ' Si on veut envoyer la feuille active

    If Sh.Range("e1").Value Like "?*@?*.?*" Then
      ' Chemin et nom du fichier
      sPathFic = TempFilePath & Sh.Name & ".xlsx"
      ' COPIER la feuille dans un nouveau classeur
      Sh.Copy
      With ActiveWorkbook
        .SaveAs Filename:=sPathFic
        .Close
      End With

      Set iMsg = CreateObject("CDO.Message")
      With iMsg
        '.Configuration.Fields.Item _
          (a noter)
        '.Configuration.Fields.Item _
          (a noter)
        '.Configuration.Fields.Item _
          (a noter)

        .Configuration.Fields.Update
        .To = Sh.Range("e1").Value
        .From = "adresse mail"
        .Subject = "Offre de Dégagement ACLV : " & Sh.Range("d18").Value
        .AddAttachment sPathFic
        .TextBody = "Bonjour,"
        .Send
      End With
      Set iMsg = Nothing
      Kill sPathFic
    End If
    Set iConf = Nothing
    Set Flds = Nothing

    With Application
      .ScreenUpdating = True
      .EnableEvents = True
    End With
    MsgBox "L'offre a bien été envoyée !"
End Sub

@+

Bonjour,

Je viens d'essayer ton code mais cela l'envoi aussi en pièce jointe et non directement dans le corps du mail.

Merci

Re,

Désolé, je n'avais pas bien lu l'énoncé

Il faut alors utiliser la méthode de Ron de Bruin ICI

C'est fait pour Outlook, mais ce doit être adaptable (ou pas) à CDO

@+

Merci,

Mais j'ai une problématique à chaque fois je n'arrive pas à adapter les choses Outlook en Gmail . Je suis pas super calé en vba.

Si tu peux m'aider ça sera avec plaisir :)