如何通过vba将excel数据表粘贴到outlook中答案

【问题标题】：How to paste excel data table into outlook through vba如何通过vba将excel数据表粘贴到outlook中
【发布时间】：2015-07-17 12:25:15
【问题描述】：

Private Sub CommandButton23_Click()

Dim objOutlook As Object
Dim objMail As Object
Dim rngTo As Range
Dim rngSubject As Range
Dim rngBody As Range
Dim rngAttach As Range

Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)

With ActiveSheet
    Set rngTo = Sheets("Helpdesk Data").Range("D4")
    Set rngSubject = Sheets("Helpdesk Data").Range("I5")
    'Set rngBody = Sheets("Helpdesk Data").Range("D4")
    'Set rngAttach = .Range("B4")

     End With

Sheets("Helpdesk Data").Select
Sheets("Helpdesk Data").Range("B12:Z12").Select
Sheets("Helpdesk Data").Range(Selection, Selection.End(xlDown)).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy

现在我想将上面复制的数据从“帮助台数据”粘贴到 Outlook 正文中，但不知道该怎么做。我尝试使用 Outlook 对象进行特殊粘贴，但它也会显示错误。

With objMail
    '.To = rngTo.Value
    .Subject = "Owner Issue at Site " & rngSubject.Value & " - (" & rngTo.Value & " Circle)"
    .Body = "Sir, " & _
    "Please find below site issue reported Today."

    '.Attachments.Add rngAttach.Value
    .Display

End With

Set objOutlook = Nothing
Set objMail = Nothing
Set rngTo = Nothing
Set rngSubject = Nothing
Set rngBody = Nothing
Set rngAttach = Nothing

End Sub

所以任何人都可以告诉我如何将“帮助台数据”表中的 B12 到 Z12 数据粘贴到 Outlook 正文..

【问题讨论】：

try .Body = "Sir, " & _ "请在下面找到今天报告的网站问题。" & vbnewline & 选择
现在它在 .body 行显示类型不匹配错误..
就是这样试试 selection.value
我尝试复制并特殊粘贴单个单元格数据，然后它可以完美运行，但我想粘贴一系列数据，其中包含表格和预格式化，但它不工作..
您可以将其设为 HTML 邮件项，然后将单元格值一一拉入 HTML 格式的表格中。 attachments.add 仅适用于文件，因此要将其添加为附件，您可以将其复制到新工作簿中，然后将该工作簿附加到电子邮件中

标签： vba excel

【解决方案1】：

一种方法是使用.HTMLBody 属性并将所需范围转换为HTML 格式。

在您的电子邮件子中，使用您的objMail，包括.HTMLBody 属性并将一个范围传递给rngHTML 函数。

.HTMLBody = "Table below." & vbNewLine & rngHTML(Range("A1:B10"))

在代码中包含生成 HTML 范围的函数。

Function rngHTML(Rng As Range)
    Dim fso As Object, ts As Object, TempWB As Workbook
    Dim TempFile As String

    TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
    '' copy the range and create a new workbook to paste the data into
    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 rngHTML
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    rngHTML = ts.readall
    ts.Close
    rngHTML = Replace(rngHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")

    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

请查看Ron de Bruin's 网站，这是我最初遇到此功能的地方；他还解释了另一种将范围放入电子邮件正文的方法。

希望这会有所帮助。

【讨论】：