Excel VBA按"Expired"条件发邮件 弹出多个Outlook窗口问题

• 主过程逻辑冗余：CommandButton1_Click中每匹配到1个"Expired"值，就调用一次发信子过程，触发独立的发信流程，这是弹出多个Outlook窗口的直接原因
• 发信子过程逻辑错配：子过程没有使用传入的邮箱地址参数，反而额外遍历A列拼接收件人，既偏离了“取F列匹配行左侧3列邮箱”的需求，又因为被重复调用，每次都新建Outlook对象、新建邮件草稿，进一步放大了多窗口的问题
• 对象生命周期管理混乱：每次调用发信子过程时都新建Outlook实例，发完就销毁，没有做全局复用，导致反复拉起Outlook进程

Private Sub CommandButton1_Click()
    Dim c As Range
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
    Dim SendTo As String
    
    ' 全流程仅初始化一次Outlook实例，全程复用避免重复创建
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    SendTo = ""
    
    ' 遍历指定的F5:F42目标区域
    For Each c In Range("F5:F42")
        If c.Value2 = "Expired" Then
            ' 提取左侧偏移3列的非空邮箱地址，用分号拼接为统一收件人列表
            If c.Offset(0, -3).Value2 <> "" Then
                SendTo = SendTo & c.Offset(0, -3).Value2 & ";"
            End If
        End If
    Next c
    
    ' 未匹配到有效收件人时直接退出流程
    If SendTo = "" Then
        MsgBox "未找到需要发送提醒的过期培训人员邮箱", vbInformation
        GoTo ReleaseObj
    End If
    
    ' 配置统一的邮件内容
    strbody = "Hello," & vbNewLine & vbNewLine & _
              "You are receiving this email because your Wastewater Pathogens (Annual) is now expired or will expire within the next 30 days. Please sign up for the next available class in LMS. If you are unable to sign up in LMS, please contact Christa Scott." & vbNewLine & _
              "Thank you and have a nice day."
    
    With OutMail
        .To = SendTo
        .CC = ""
        .BCC = ""
        .Subject = "Expired Hazmat Right-to-Know Training - " & Date
        .Body = strbody
        ' 仅弹出1次Outlook预览窗口，确认后统一发送
        .Display
    End With

ReleaseObj:
    ' 统一释放对象资源，避免后台进程残留
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

• 全流程仅创建1个Outlook实例、1封邮件草稿，从根本上解决多窗口弹出的问题
• 严格匹配需求取数：删除原代码中无关的A列遍历逻辑，仅从F5:F42匹配"Expired"的行提取对应左侧3列的邮箱地址作为收件人
• 增加空值校验逻辑，未匹配到有效收件人时直接弹出提示退出，不生成无意义的空白邮件
• 规范对象释放流程，避免后台残留Outlook进程占用系统内存

内容的提问来源于stack exchange，提问作者PowerAppsNewbie