如何在带截图的Outlook邮件中添加文本？（附VBA代码）

你的代码已经实现了指定区域截图插入邮件的功能，要添加自定义文本，只需要利用Outlook邮件绑定的Word编辑器对象（wdDoc）直接操作正文内容即可。下面是修改后的完整代码，以及关键修改说明：

修改后的完整代码 #

Public Sub ScreenShotResults2()
        Dim rng As Range
        Dim olApp As Object
        Dim Email As Object
        Dim wdDoc As Word.Document
        ' 新增文本内容变量
        Dim strBody As String

        Set rng = Sheets("Summary").Range("B20:I34")
            rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture

        With Application
            .EnableEvents = False
            .ScreenUpdating = False
        End With

        Set olApp = CreateObject("Outlook.Application")
        Set Email = olApp.CreateItem(0)
        Set wdDoc = Email.GetInspector.WordEditor

        ' 定义邮件正文文本，可按需修改内容和换行
        strBody = "See production data for most recent 3 months." & vbCrLf & vbCrLf

        With Email
            .To = Worksheets("Summary").Range("B22").Value
            .Subject = "4 Month LO Production Lookback for " & Worksheets("Summary").Range("B22").Value
            .Display

            ' 先插入文本内容到邮件正文
            wdDoc.Range.Text = strBody
            ' 将光标移动到文本末尾，再粘贴截图（保证文本在截图上方）
            wdDoc.Range(wdDoc.Range.End - 1, wdDoc.Range.End - 1).Select
            wdDoc.Range.PasteAndFormat Type:=wdChartPicture

            ' 调整截图高度（保留原代码逻辑）
             With wdDoc
                .InlineShapes(1).Height = 250
             End With
        End With

        With Application
            .EnableEvents = True
            .ScreenUpdating = True
        End With

        ' 释放所有对象，避免内存泄漏
        Set Email = Nothing
        Set olApp = Nothing
        Set wdDoc = Nothing
End Sub

关键修改说明 #

• 新增文本变量：定义strBody变量存储邮件文本，用vbCrLf实现换行，可直接修改内容适配需求
• 调整内容插入顺序：先写入文本，再把光标移到文本末尾粘贴截图，保证排版逻辑清晰
• 优化对象管理：新增Set wdDoc = Nothing，完善内存释放逻辑

如果需要给文本设置格式（比如字体、字号），可以在插入文本后添加这段代码：

With wdDoc.Range.Font
    .Name = "Calibri"
    .Size = 12.5
    .ColorIndex = wdBlack
End With

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