如何通过VBA将Excel数据表粘贴到Outlook中

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对象试过Specialpaste，但它也显示错误..

 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主体..

Answer 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的网站，这是我最初遇到这个function的地方; 他还解释了另一种将范围引入电子邮件正文的方法。

希望这可以帮助。