如何知道电子邮件在通过vba excel发送时是否已发送且未关闭？

Sub SendEmail()
    Dim OutlookApp As Object
    Dim OutlookMail As Object
    
    ' 创建Outlook应用程序对象
    Set OutlookApp = CreateObject("Outlook.Application")
    ' 创建邮件对象
    Set OutlookMail = OutlookApp.CreateItem(0)
    
    With OutlookMail
        ' 设置邮件主题
        .Subject = "邮件主题"
        ' 设置收件人
        .To = "收件人邮箱地址"
        ' 设置邮件内容
        .Body = "邮件内容"
        ' 发送邮件
        .Send
    End With
    
    ' 释放对象
    Set OutlookMail = Nothing
    Set OutlookApp = Nothing
End Sub

Sub CheckEmailStatus()
    Dim OutlookApp As Object
    Dim OutlookNamespace As Object
    Dim OutlookFolder As Object
    Dim OutlookMail As Object
    
    ' 创建Outlook应用程序对象
    Set OutlookApp = CreateObject("Outlook.Application")
    ' 获取Outlook命名空间
    Set OutlookNamespace = OutlookApp.GetNamespace("MAPI")
    ' 获取已发送邮件文件夹
    Set OutlookFolder = OutlookNamespace.GetDefaultFolder(5)
    
    ' 遍历已发送邮件文件夹中的邮件
    For Each OutlookMail In OutlookFolder.Items
        ' 判断邮件主题、收件人等信息来确定是否为刚发送的邮件
        If OutlookMail.Subject = "邮件主题" And OutlookMail.To = "收件人邮箱地址" Then
            ' 判断邮件状态
            If OutlookMail.Sent = True And OutlookMail.SentOnBehalfOfName = "" Then
                MsgBox "邮件已发送且未关闭"
            Else
                MsgBox "邮件发送失败或已关闭"
            End If
            Exit For
        End If
    Next OutlookMail
    
    ' 释放对象
    Set OutlookFolder = Nothing
    Set OutlookNamespace = Nothing
    Set OutlookApp = Nothing
End Sub