将工作表范围粘贴到电子邮件正文中

Question

我有一张表格来填写有关关键问题的信息，以便管理到作战室。

当发生关键问题时，团队会发送公告。

由于旧流程在这些公告中缺乏标准化，我创建了一个具有电子邮件自定义布局的工作表。

为了防止工作人员编辑此布局，我保护了工作表并创建了带有宏的按钮来生成这些公告。

下面是此工作表的屏幕截图。这些单元从 B6 开始，到 L27 结束。工作表名称是“Planilha5”。

当我单击工作表上的“发送”按钮时，我需要在 Microsoft Outlook 365 中调用一条新邮件，并填充信息以及粘贴到邮件正文中的工作表定义的范围。

Sub EnviarAbertura()
    Dim Outlook As Object, Novo_Email As Object, Email_Body As String, b1 As Variant

    b1 = Planilha5.Range("B6:L27")

    Set Outlook = CreateObject("Outlook.application")

    Email_Body = b1
    
    Set Novo_Email = Outlook.CreateItem(0)
    Corpo = Planilha5.Range("B6:L27").Copy
    
    With Novo_Email
        .SentOnBehalfOfName = "[email protected]"
        .Subject = Planilha5.Range("G4")
        .Body = Email_Body
        .Display
    End With
    
End Sub

当我评论这些行时，脚本可以在没有填充正文的情况下运行。

b1 = Planilha5.Range("B6:L27")

Email_Body = b1

.Body = Email_Body`

我已将工作表范围手动粘贴到下面的屏幕截图中，以显示我的期望。

Answer 1

根据Excel数据设置邮件正文主要有两种方式：

1. 根据工作表内容构建 HTML 标记。这基本上就是 Ron 在“邮件正文中的邮件范围/选择”页面上描述的内容，您可以在其中找到以下示例代码：

   Function RangetoHTML(rng As Range)
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook
   
    TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
   
    'Copy the range and create a new workbook to past the data in
    rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With
   
    'Publish the sheet to a htm file
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With
   
    'Read all data from the htm file into RangetoHTML
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.readall
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")
   
    'Close TempWB
    TempWB.Close savechanges:=False
   
    'Delete the htm file we used in this function
    Kill TempFile
   
    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
    End Function

   注意，获取 HTML 标记后，您需要使用 

   HTMLBody

   属性，而不是纯文本

   Body

   。

您可以使用
2. Range.Copy

   方法在 Excel 中复制所需范围，然后使用 Word 编辑器直接粘贴到邮件正文，请参阅 WordEditor 类的

   Inspector

   属性。该属性返回所显示消息的 Microsoft Word 文档对象模型。有关更多信息，请参阅

   第 17 章：使用项目主体

   。