Sub EnvoyerEmail()
' Par Excel-Malin.com ( https://excel-malin.com )
' Adapté par Jean-Paul
' Date : 06/08/2019
On Error GoTo EnvoyerEmail_Erreur
Dim oOutlook As Outlook.Application, WasOutlookOpen As Boolean, oMailItem As Outlook.MailItem
Dim Body As Variant, Subject As String
Dim Filename1 As String, LineHeader As String, sFolder As String
Dim bOpenAfterPublish As Boolean
sFolder = "TonChemin"
Subject = "Ton sujet"
'Ci-dessous une selectcase pour choisir soit un fichier xlsx soit un PDF
'A adapter selon ton choix
Select Case "A adapter selon ton choix"
Case 0 'Save as PDF
'Le nom FileName1 est aussi à adapter selon ton choix
Filename1 = sFolder & _
Subject & ".pdf"
ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=Filename1, _
Quality:=xlQualityStandard, IncludeDocProperties:=False, _
IgnorePrintAreas:=False, From:=1, To:=1, OpenAfterPublish:=bOpenAfterPublish
Case 1 'Save as Xlsm
Filename1 = sFolder & _
Subject & ".xlsm"
ActiveWorkbook.SaveCopyAs Filename1
Case Else
End Select
Body = "<!DOCTYPE HTML PUBLIC ""-//W3C//DTD HTML 4.0 Transitional//EN"">" & _
"<HTML><HEAD>" & _
"<META http-equiv=Content-Type content=""text/html; charset=iso-8859-1"">" & _
"<META content=""MSHTML 6.00.2800.1516"" name=GENERATOR></HEAD>" & _
"<BODY><DIV STYLE=""font-size: 16px; font-face: Book Antiqua;"">"
Body = Body & "Bonjours ci-joint les documents demandés<br>Cordialement, M. XXX"
'Application_ItemSend
'Préparer Outlook
PreparerOutlook oOutlook
Set oMailItem = oOutlook.CreateItem(0)
'Création de l'email
With oMailItem
'.From = "Mettre l'expéditeur sinon par défaut"
.To = "Destinataire@exemple.fr"
.cc = "Destinataire1@exemple.fr"
.Subject = Subject
.BodyFormat = olFormatHTML
.HTMLBody = Body & "<br><br>" & .HTMLBody 'Signature Body & "<br><br>" &
.Attachments.Add Filename1
If "A adapter a tes besoins pour voir le courriel avant l'envoie" = True Then
.Display '<- affiche l'email (si vous ne voulez pas l'afficher, mettez cette ligne en commentaire)
End If
'.Save '<- sauvegarde l'email avant l'envoi (pour ne pas le sauvegarder, mettez cette ligne en commentaire)
'.Send '<- envoie l'email (si vous voulez seulement préparer l'email et l'envoyer manuellement, mettez cette ligne en commentaire)
End With
EnvoyerEmail_Exit:
If (Not (oMailItem Is Nothing)) Then Set oMailItem = Nothing
If (Not (oOutlook Is Nothing)) Then Set oOutlook = Nothing
Exit Sub
EnvoyerEmail_Erreur:
MsgBox "Oupss... le mail n'a pas pu être envoyé..." & vbNewLine & Err, vbCritical, "Erreur"
Resume EnvoyerEmail_Exit
End Sub
Private Sub PreparerOutlook(ByRef oOutlook As Object)
'par Excel-Malin.com ( https://excel-malin.com )
'Ce code vérifie si Outlook est prêt à envoyer des emails... Et s'il ne l'est pas, il le prépare.
On Error GoTo PreparerOutlookErreur
On Error Resume Next
'vérification si Outlook est ouvert
Set oOutlook = GetObject(, "Outlook.Application")
If (Err.Number <> 0) Then 'si Outlook n'est pas ouvert, une instance est ouverte
Err.Clear
Set oOutlook = CreateObject("Outlook.Application")
Else 'si Outlook est ouvert, l'instance existante est utilisée
Set oOutlook = GetObject("Outlook.Application")
oOutlook.visible = True
End If
Exit Sub
PreparerOutlookErreur:
MsgBox "Oups..." & vbNewLine & "Nous n'avons pas pu charger Outlook !"
End Sub
