Envoi de mail depuis Excel avec pièce jointe

Bonjour,

Nous cherchons à envoyer un mail à partir d'Excel avec une VBA et à joindre une feuille spécifique d'Excel à ce mail.

Malheureusement notre Macro ne fonctionne pas (voir ci-dessous).

9exemple.xlsm (29.53 Ko)

Le code

Sub Mail()

On Error GoTo EnvoyerEmailErreur

'définition des variables
Dim objOL As Object
Set objOL = CreateObject("Outlook.Application")

Dim objOL As Outlook.Application

Set objOL = New Outlook.Application

If Len(ContenuEmail) = 0 Then
MsgBox "Mail non envoyé car vide", vbOKOnly, "Message"

Exit Sub

End If

'préparer Outlook

PreparerOutlook oOutlook
Set oMailItem = oOutlook.CreateItem(0)

'création de l'email

With oMailItem
.To = Range("H13:J15")
.Subject = .Range("B20:J20") & ESPACE & .Range("H8")

.BodyFormat = olFormatHTML
.HTMLBody = "<html><p>" & ContenuEmail & "</p></html>"

If PieceJointe <> "" Then .Attachments.Add PieceJointe

Exit Sub

Pouvez-vous nous aider pour que nous puissions envoyer le mail à partir d'Excel.

Merci :)

Bonjour,

Vous devriez trouver votre bonheur dans ce fichier en téléchargement
https://www.excel-pratique.com/fr/telechargements/utilitaires/pdf-email-vba-excel-no508

A+

Merci pour votre retour,

J'ai réussi à trouver une macro qui me permet de joindre à mon mail seule la feuille de calcul que je souhaite.

Néanmoins, je souhaite que les données dans cette feuille ne soit que des valeurs et non des formules.

Savez-vous comment je peux modifier ma macro ?

Sub Envoyer()

Dim xFile As String
Dim xFormat As Long
Dim Wb As Workbook
Dim Wb2 As Workbook
Dim FilePath As String
Dim FileName As String
Dim OutlookApp As Object
Dim OutlookMail As Object
On Error Resume Next
Application.ScreenUpdating = False
Set Wb = Application.ActiveWorkbook
ActiveSheet.Copy
Set Wb2 = Application.ActiveWorkbook
Select Case Wb.FileFormat

Case xlOpenXMLWorkbook:
xFile = ".xlsx"
xFormat = xlOpenXMLWorkbook
Case xlOpenXMLWorkbookMacroEnabled:
If Wb2.HasVBProject Then
xFile = ".xlsm"
xFormat = xlOpenXMLWorkbookMacroEnabled

Else
xFile = ".xlsx"
xFormat = xlOpenXMLWorkbook
End If
Case Excel8:
xFile = ".xls"
xFormat = Excel8
Case xlExcel12:
xFile = ".xlsb"
xFormat = xlExcel12

End Select
FilePath = Environ$("temp") & "\"
FileName = "2023"
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)
Wb2.SaveAs FilePath & FileName & xFile, FileFormat:=xFormat

Dim LeMail As Variant

Set LeMail = CreateObject("Outlook.Application")

With LeMail.CreateItem(olMailItem)
.To = Range("H13")
.Cc =
.Subject = Range("H8") & " - 2023"
.Body = Range("B205")
.Attachments.Add Wb2.FullName
.Display

End With

Wb3.Close
Kill FilePath & FileName & xFile
Set OutlookMail = Nothing
Set OutlookApp = Nothing
Application.ScreenUpdating = True

End Sub

Edit modo : merci de mettre le code entre balises avec le bouton

Merci d'avance

Bonjour Formule Excel

Je viens d'éditer votre post précédent, merci de mettre le code entre balises SVP

Pour ce que vous souhaité, une fois la feuille copiée dans un autre classeur
Il faut copier les cellules et faire un collage spécial / valeurs

A+

Rechercher des sujets similaires à "envoi mail piece jointe"