如何在循环中逐个显示邮件并添加自动/手动发送选项？

首先，咱们来拆解下你现有代码的核心问题：你只初始化了一个Outlook.MailItem对象，每次循环都复用它，所以每次调用.Display时，Outlook会把旧的邮件窗口替换成新内容，自然只能看到最后一封。要实现逐个打开不关闭的效果，关键是每次循环都创建全新的邮件实例。

另外，我给你加上了两种发送模式的选择：自动发送（无需预览直接发），或者预览后手动发送。下面是修改后的完整代码：

Sub TestWithOptions()
    Dim i As Integer
    Dim wB As Workbook: Set wB = ThisWorkbook
    Dim wsD As Worksheet: Set wsD = wB.Worksheets("Data")
    Dim wsE As Worksheet: Set wsE = wB.Worksheets("Email Format")
    Dim LastRowsData As Integer
    Dim LastRowEmail As Integer
    Dim OA As Outlook.Application: Set OA = New Outlook.Application
    Dim msg As Outlook.MailItem ' 仅声明对象，初始化放到循环内
    Dim sendMode As VbMsgBoxResult ' 存储用户选择的发送模式
    
    ' 弹出选择框让用户确定发送模式
    sendMode = MsgBox("请选择邮件发送模式：" & vbCrLf & vbCrLf & _
                     "【是】：自动发送所有邮件（无预览）" & vbCrLf & _
                     "【否】：逐个预览邮件，手动发送", _
                     vbYesNoCancel + vbQuestion, "发送模式选择")
    
    If sendMode = vbCancel Then Exit Sub ' 用户取消则直接退出
    
    ' --- 原有数据处理逻辑保持不变 ---
    LastRowsData = Worksheets("Data").Cells(Rows.Count, 1).End(xlUp).Row + 1
    LastRowEmail = Worksheets("Email Format").Cells(Rows.Count, 1).End(xlUp).Row
    
    For i = 2 To LastRowsData
        If Not IsError(Application.Match(wsD.Range("H" & i).Value, _
        wsD.Range("A1:A" & LastRowsData), 0)) Then
            LastRowEmail = LastRowEmail + 1
            wsE.Range("A" & LastRowEmail).Value = wsD.Range("G" & i).Value
        End If
    Next i
    
    ' --- 循环生成邮件的核心修改部分 ---
    For i = 2 To LastRowEmail
        ' 每次循环新建一个MailItem实例，避免覆盖之前的邮件窗口
        Set msg = OA.CreateItem(olMailItem)
        
        With msg
            .BodyFormat = olFormatHTML
            .HTMLBody = wsE.Range("D" & i).Value
            .To = wsE.Range("A" & i).Value
            .Subject = wsE.Range("C" & i).Value
            
            ' 根据用户选择的模式处理邮件
            Select Case sendMode
                Case vbYes ' 自动发送模式
                    .Send
                    MsgBox "已自动发送第 " & i - 1 & " 封邮件", vbInformation
                Case vbNo ' 预览手动发送模式
                    .Display ' 打开新的邮件窗口，不会关闭之前的
            End Select
        End With
        
        Set msg = Nothing ' 释放当前邮件对象，优化内存
    Next i
    
    ' 完成后的提示信息
    If sendMode = vbYes Then
        MsgBox "所有邮件已自动发送完成！", vbInformation
    Else
        MsgBox "所有邮件已生成并预览，请手动处理发送！", vbInformation
    End If
    
    Set OA = Nothing ' 释放Outlook应用对象
End Sub

关键改动说明： #

• 独立邮件实例：把Set msg = OA.CreateItem(olMailItem)移到循环内部，每一封邮件都是全新的对象，.Display时会打开新窗口，不会覆盖之前的邮件。
• 发送模式选择：通过MsgBox让用户在开始前选择操作模式，避免重复确认。
• 对象内存优化：每次循环后释放当前邮件对象，最后释放Outlook应用对象，减少内存占用。
• 状态提示：添加了进度和完成提示，让用户清楚操作状态。

注意事项： #

• 确保Outlook已登录且具备发送权限；
• 自动发送模式会直接发送邮件，建议先测试少量数据验证内容；
• 预览模式下所有邮件窗口会保留，可逐个检查后手动点击发送。

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