Boostez vos compétences Excel avec notre communauté !
Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !
Private Sub EnvoiMailOutlookAvecFeuilJointe()
Dim OutApp As Object, OutMail As Object, NewB As Workbook
'---- variables nécessaire -------------
NomDuClasseur$ = "NomDeLaPieceJointe.xls" ' avec son extention
NomDeLaFeuille$ = "Feuil2"
AdresDestinMail$ = "nom@site.fr"
AdresMailCC$ = "nom@site.fr"
AdresMailBCC$ = "nom@site.fr"
Sujet$ = ""
Message$ = ""
'----------------------------------------
' Copie la feuille (ce qui cré un nouveau classeur qui devient actif)
CheminFichier$ = ThisWorkbook.Path & "\" & NomDuClasseur$ 'ajoute le chemin
Sheets(NomDeLaFeuille$).Copy
Set NewB = ActiveWorkbook
ActiveWorkbook.SaveAs CheminFichier$
' ENVOI
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error GoTo ErreurNET
With OutMail
.To = AdresDestinMail$
.CC = AdresMailCC$
.BCC = AdresMailBCC$
.Subject = Sujet$
.Body = Message$
.Attachments.Add NewB.FullName
'.Send '<<<<<<<<<<<< Pour envoyer directement
.Display '<<<<<<<<< Pour voir le mail avant envoi
'après .Display pour sauter message de confirmation> SendKeys "^{ENTER}"
End With
' close le classeur et le supprime du disque
ActiveWorkbook.Close
Kill CheminFichier$
' fin
Set OutApp = Nothing: Set OutMail = Nothing: Set NewB = Nothing
On Error GoTo 0: Err.Clear
Exit Sub
ErreurNET: ' sous prog erreur
Msg$ = "Erreur " & Err.Source & " No " & Err.Number & vbLf & vbLf & Err.Description
t$ = "Envoi Mail: Problème de connexion !?"
MsgBox Msg$, vbCritical, t$, Err.HelpFile, Err.HelpContext
On Error GoTo 0: Err.Clear
End Sub
