Microsoft 365 VBA envoi Mail avec Outlook

Option Explicit

'Nécessite d'activer la référence 'Microsoft Outlook XX.0 Object Library'

Private m_o_olApp As Outlook.Application
Private m_o_olOutbox As Outlook.Folder
Private WithEvents m_o_itemsSent As Outlook.Items
Private m_b_alreadyOpened As Boolean


Public Property Get olApp() As Outlook.Application
    If m_o_olApp Is Nothing Then
        'essayer de récupérer l'instance d'Outlook s'il est déjà ouvert
        On Error Resume Next
         Set m_o_olApp = GetObject(, "Outlook.Application")
        On Error GoTo 0
        'si Outlook n'était pas ouvert, créer une nouvelle instance
        m_b_alreadyOpened = Not m_o_olApp Is Nothing
        If Not m_b_alreadyOpened Then Set m_o_olApp = CreateObject("Outlook.Application")
        'récupérer l'outbox et les éléments envoyés
        If m_o_olOutbox Is Nothing Then
            Set m_o_olOutbox = m_o_olApp.Session.GetDefaultFolder(olFolderOutbox)
            Set m_o_itemsSent = m_o_olApp.Session.GetDefaultFolder(olFolderSentMail).Items
        End If
    End If
    Set olApp = m_o_olApp
End Property

'évènement se déclenchant quand un élément est ajouté au dossier 'éléments envoyés'
Private Sub m_o_itemsSent_ItemAdd(ByVal Item As Object)
    'si outlook n'était pas ouvert et que l'outbox est vide
    If (Not m_b_alreadyOpened) And (m_o_olOutbox.Items.Count = 0) Then
        'fermer outlook
        m_o_olApp.Quit
        Set m_o_olApp = Nothing
        Set m_o_olOutbox = Nothing
        Set m_o_itemsSent = Nothing
    End If
End Sub

Private Property Get olApp() As Outlook.Application
Static l_o_ol As Cls_Outlook
    If l_o_ol Is Nothing Then Set l_o_ol = New Cls_Outlook
    Set olApp = l_o_ol.olApp
End Property


Sub Test()
Dim l_o_mail As Outlook.MailItem
   
    Set l_o_mail = olApp.CreateItem(olMailItem)
    With l_o_mail
        .To = "toto.tutufree.fr"
        .Subject = "test9998"
        .Body = "Coucou"
        .Send
    End With
   
    Set l_o_mail = Nothing
End Sub