Microsoft 365 VBA envoi Mail avec Outlook

Private Sub btn_fermer_Click()

Dim Appli As Object
    Dim SessionOutlook, myOlApp
    Const Chemin As String = "C:\Program Files (x86)\Microsoft Office\root\Office16\OUTLOOK.exe"   '---> tu adaptes ce chemin si c'est nécessaire
 
    On Error Resume Next
    Set Appli = GetObject(, "Outlook.Application")
 
    'Tester si l'application est ouverte ou non
    If Appli Is Nothing Then
            MsgBox "Outlook est fermé"   '---> Donc ouvre moi une session
            SessionOutlook = Shell(Chemin, 1)

'sauvegarde fichier

    sauvegarde_fichier_fermeture
    

' envoi MAIL
    
    envoi_mail_fermeture
    
            Else
            
'sauvegarde fichier

    sauvegarde_fichier_fermeture
    

' envoi MAIL
    
    envoi_mail_fermeture
    End If
    
      
    'Set myOlApp = CreateObject("Outlook.Application")
    '        myOlApp.Quit
      
    'Application.Quit

End Sub

Sub sauvegarde_fichier_fermeture()

'sauvegarde fichier
    Dim dossier1 As String
    Dim fichier As String
    Dim datevalidation As String
    Dim datevalidationmaj As String
        
    datevalidation = Date
    datevalidationmaj = Format(Date, "DD-mm-yy")
    dossier1 = Sheets("dossier").Range("b2")
    fichier = Sheets("dossier").Range("C2")
    
    ActiveWindow.SmallScroll Down:=-100 'repositionner ecran
    
    Application.DisplayAlerts = False
      
    With ActiveWorkbook
    .SaveAs Filename:=dossier1 & fichier & " - " & datevalidationmaj, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
 
    End With
    
'sauvegarde fichier_bureau
    Dim dossier2 As String
    Dim fichier2 As String
    
    
    dossier2 = Sheets("dossier").Range("b4")
    fichier2 = Sheets("dossier").Range("C4")
    
    Application.DisplayAlerts = False
      
    With ActiveWorkbook
    .SaveAs Filename:=dossier2 & fichier2, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
 
    End With
    
    Application.DisplayAlerts = True
      
' Message de confirmation

'MsgBox ("Le fichier a bien été sauvegardé" & vbCrLf & vbCrLf & "Merci ")

End Sub

Sub envoi_mail_fermeture()

    Dim xOutlook As Object
    Dim xMailItem As Object
    Dim xEmailAddr As String
    Dim xEmailAddrCC As String
    On Error Resume Next
    
    Dim dossier1 As String
    Dim fichier As String
    Dim datevalidation As String
    Dim datevalidationmaj As String
        
    datevalidation = Date
    datevalidationmaj = Format(Date, "DD-mm-yy")
    dossier1 = Sheets("dossier").Range("b2")
    fichier = Sheets("dossier").Range("C2")
          
    Set xOutlook = CreateObject("Outlook.Application")
    Set xMailItem = xOutlook.CreateItem(0)
      
'Selection de la page des adresses mail
    Worksheets("Dossier").Activate
'Selection de la cellule nommée 'CELL_ADR_MAIL' représentant le nom de la colonne des mails dans le tableau
    Sheets("Dossier").Range("CELL_ADRESSE_MAIL").Select
'Déplacement d'une ligne en dessous pour débuter la boucle de lecture des adresses mail
    ActiveCell.Offset(1, 0).Select
    
    Do Until IsEmpty(ActiveCell)
        'If ActiveCell.Value Like "*@*" Then ' si celulle active contient une adresse mail
        If ActiveCell.Value <> "" Then ' si cellule active non vide
            If xEmailAddr = "" Then
                xEmailAddr = ActiveCell.Value
            Else
                xEmailAddr = xEmailAddr & ";" & ActiveCell.Value
            End If
        End If
        
'Lecture de l'adresse mail suivante, une ligne en dessous
        ActiveCell.Offset(1, 0).Select
    Loop
    
'Si la liste des adresses mail n'est pas vide on diffuse
    
    If xEmailAddr <> "" Then
        With xMailItem
            
            .To = xEmailAddr
            .CC = xEmailAddrCC
            .Subject = "Essai Fermeture fichier " & datevalidationmaj
            '.body = "Bonjour,"
            .Attachments.Add dossier1 & fichier & " - " & datevalidationmaj & ".xlsm"
            .display
            .Send 'validation envoi
        End With
        
        Set xOutlook = Nothing
        Set xMailItem = Nothing
    End If
    
    Combo_user = ""
    TextBox_mdp = ""
        
    
    'Annule le Masquage l'éxécution de la macro
    Application.ScreenUpdating = True

End Sub

'Set myOlApp = CreateObject("Outlook.Application")
    '        myOlApp.Quit
      
    'Application.Quit

Dim ProcessId As LongPtr
Sub test()

    ProcessId = Shell("C:\Program Files (x86)\Microsoft Office\Office15\OUTLOOK.EXE", vbNormal)


    With CreateObject("outlook.application")
        Set Email = .CreateItem(0)

        With Email

            .Subject = "toto"
            .body = "coucou"



            .display
            '.send

        End With

    End With
End Sub

Sub fermeoutlook()
    Set WMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\.\root\cimv2")
    Set ProcessList = WMIService.ExecQuery("Select * from Win32_Process Where Name = 'Outlook.exe'")

    'le problème est que chaque instance est enfant de la première
    'donc quand je ferme celle dont j'ai le processID toute les autres sont fermées aussi
    For Each process In ProcessList
        If process.Handle = ProcessId Then process.Terminate
    Next

End Sub