Outlook en premier plan

Private Sub boutonTest_Click()
Dim OL As Outlook.Application, mi As Outlook.MailItem
On Error GoTo OLMailErr
Set OL = New Outlook.Application
Set mi = OL.CreateItem(olMailItem)
With mi
.To = DestMail
.CC = CCMail
.Subject = SujetMail
.Body = TxtMail
.HTMLBody = "Test <b>Signature<\b>" & "<br>" & .HTMLBody
.Display
End With
Set mi = Nothing: Set OL = Nothing
Exit Sub
OLMailErr:
MsgBox "Erreur : " & Err.Number & vbCrLf & Err.Description
Exit Sub
End Sub

Private Sub Go_Click()

'--- On ferme le Processus Outlook ---
Dim ovc As Object
Dim sQuery As String
Dim oproc
Set ovc = GetObject("winmgmts:root\cimv2")
sQuery = "select * from win32_process where name='" & "Outlook.EXE" & "'"
For Each oproc In ovc.execquery(sQuery)
oproc.Terminate
Next
Set ovc = Nothing

' on relance outlook

Dim SessionOutlook
Const Chemin As String = "C:\Program Files\Microsoft Office\office15\OUTLOOK.exe" '  ---> tu adaptes ce chemin si c'est nécessaire
SessionOutlook = Shell(Chemin, 1)
Dim MonOutlook As Outlook.Application
Dim MonMessage As Outlook.MailItem
 
On Error GoTo Err_envoyerMail
 
    ' ===== Initialisation =====
    Set MonOutlook = CreateObject("Outlook.Application")
    Set MonMessage = MonOutlook.CreateItem(0)
 
    ' ===== Création de l'email =====
    With MonMessage
        .To = "menon.florent@gmail.com"
        .Subject = "Sujet de ce mail"
        .Body = "Ici le contenu du mail à envoyer"
        ' Affiche le mail (commenter la ligne pour envoi du mail en tâche de fond)
        .Display
        ' Envoie le mail automatiquement (décommenter la ligne pour envoi du mail en tâche de fond)
        '.Send
    End With
 
Exit_envoyerMail:

    Set MonOutlook = Nothing
    Exit Sub
 
Err_envoyerMail:
    Select Case Err.Number
        Case Else
            MsgBox "Erreur n°" & Err.Number & vbCrLf & "Description : " & Err.Description & vbCrLf & "Source : " & Err.Source, vbCritical, "Erreur"
    End Select
    Resume Exit_envoyerMail
 


End Sub