将Excel直接发送邮件改为在Outlook中显示草稿邮件

原代码使用Excel内置的邮件信封功能（MailEnvelope），该功能的.Display方法仅会在Excel界面显示信封，无法唤起Outlook的邮件编辑窗口。要实现需求，需改用Outlook对象模型直接创建邮件草稿，以下是修改后的完整代码：

Sub CreateOutlookDraft()
    Dim AWorksheet As Worksheet
    Dim Sendrng As Range
    Dim rng As Range
    Dim olApp As Object ' Outlook.Application
    Dim olMail As Object ' Outlook.MailItem
    Dim introText As String

    On Error GoTo StopMacro

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .CutCopyMode = False ' 清理剪贴板残留内容
    End With

    ' 指定要嵌入邮件的表格范围
    Set Sendrng = Range("B1:M44")
    Set AWorksheet = ActiveSheet
    Set rng = ActiveCell ' 记录原活动单元格

    ' 初始化Outlook实例：优先获取已打开的实例，未打开则新建
    On Error Resume Next
    Set olApp = GetObject(, "Outlook.Application")
    If Err.Number <> 0 Then
        Set olApp = CreateObject("Outlook.Application")
    End If
    On Error GoTo StopMacro

    ' 创建新邮件草稿
    Set olMail = olApp.CreateItem(0) ' 0对应Outlook的olMailItem类型

    ' 复制Excel表格并转换为HTML格式（保留样式）
    Sendrng.Copy
    introText = "Dear All," & vbNewLine & vbNewLine & "Please find XXX." & vbNewLine & vbNewLine

    With olMail
        .To = "XXXX"
        .Subject = "XXX"
        ' 合并引言文本与表格HTML到邮件正文
        .HTMLBody = introText & "<br>" & GetHTMLFromClipboard()
        .Display ' 打开Outlook邮件编辑窗口（草稿状态）
    End With

    ' 恢复Excel原状态
    AWorksheet.Select
    rng.Select

StopMacro:
    ' 清理对象并恢复Excel设置
    Set olMail = Nothing
    Set olApp = Nothing
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .CutCopyMode = False
    End With
End Sub

' 辅助函数：从剪贴板提取HTML格式内容
Function GetHTMLFromClipboard() As String
    Dim objData As Object
    Set objData = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") ' MSForms.DataObject
    objData.GetFromClipboard
    GetHTMLFromClipboard = objData.GetText(1) ' 1代表HTML格式数据
End Function

关键改动说明 #

1. 替换邮件创建逻辑：放弃Excel内置的MailEnvelope，直接调用Outlook对象模型创建邮件，确保唤起Outlook窗口。
2. 保留表格样式：通过复制+提取HTML的方式，将Excel表格完整嵌入邮件正文，避免格式丢失。
3. 草稿打开方式：使用.Display替代原代码的.Send，直接打开Outlook邮件编辑窗口，支持后续手动添加内容。
4. 兼容性处理：增加Outlook实例的错误捕获，兼容Outlook已打开/未打开的场景。

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