VBA生成Outlook邮件时末尾内容覆盖前文问题求助

问题根源 #

核心问题是最后一行代码.GetInspector.WordEditor.Range.Text = "Best Regards"直接替换了邮件正文的全部内容，而非追加到现有内容之后。之前设置的问候语、粘贴的表格内容都被这行代码覆盖，最终只显示末尾文本。

修正后的完整代码 #

通过定位光标到正文末尾实现内容追加，同时保留表格格式：

Sub ConvertToPDFAndEmailWithSheetContent()
    Dim PDFFileName As String
    Dim OutApp As Object
    Dim OutMail As Object
    Dim QuoteSheet As Worksheet
    Dim WordDoc As Object
    Dim SelectionObj As Object

    ' 设置PDF文件名和路径
    PDFFileName = ThisWorkbook.Path & "\" & Replace(ThisWorkbook.Name, ".xlsm", ".pdf")

    ' 隐藏F6单元格为空的工作表
    For Each ws In ThisWorkbook.Sheets
        If IsEmpty(ws.Range("F6").Value) Then
            ws.Visible = xlSheetHidden
        End If
    Next ws

    ' 将工作簿另存为PDF
    ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, FileName:=PDFFileName, Quality:=xlQualityStandard

    ' 创建Outlook应用和邮件对象
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    Set QuoteSheet = ThisWorkbook.Sheets("Price Quote")

    ' 复制报价表的已用区域
    QuoteSheet.UsedRange.Copy

    With OutMail
        .Subject = "Price Quotation"
        .To = "recipient@example.com" ' 替换为收件人邮箱
        .Attachments.Add PDFFileName
        
        ' 获取邮件的Word编辑器对象
        Set WordDoc = .GetInspector.WordEditor
        Set SelectionObj = WordDoc.Application.Selection

        ' 写入开头文本
        SelectionObj.TypeText "Dear recipient," & vbCrLf & vbCrLf & "Please find the price quote details below:" & vbCrLf & vbCrLf
        
        ' 定位到文本末尾并粘贴表格内容
        SelectionObj.EndKey Unit:=6 ' wdStory = 6，定位到文档末尾
        SelectionObj.Paste ' 粘贴复制的表格
        
        ' 换行后写入结尾问候
        SelectionObj.TypeText vbCrLf & vbCrLf & "Best Regards"
        
        .Display ' 替换为.Send可自动发送邮件
    End With

    ' 清理资源
    Application.CutCopyMode = False
    Set QuoteSheet = Nothing
    Set WordDoc = Nothing
    Set SelectionObj = Nothing
    Set OutMail = Nothing
    Set OutApp = Nothing

    ' 可选：删除生成的PDF文件
    Kill PDFFileName
    
    UnhideAllSheets
End Sub

关键修改点 #

• 使用WordDoc.Application.Selection控制光标位置，通过EndKey Unit:=6定位到文档末尾，避免覆盖现有内容。
• 用SelectionObj.TypeText追加文本，而非直接赋值.Range.Text。
• 调整代码顺序，先设置邮件主题、收件人等属性，逻辑更清晰。

额外说明 #

• 若需精确格式控制（如字体、段落间距），可基于WordDoc对象调用Word的VBA方法，例如SelectionObj.Font.Name = "Arial"。
• 确保UnhideAllSheets过程已正确定义，否则需补充代码恢复隐藏的工作表。

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