Excel范围添加到电子邮件模板

给出下面的函数，我希望将variables%TABLE_HERE%replace为附加到电子邮件的Excel电子表格的范围生成的表。

 Public Function GenerateEmail(fileName As String, tbleRange As Range) Application.ScreenUpdating = False Dim OutApp As Object Dim OutMail As Object Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItemFromTemplate(fileName) With OutMail .HTMLbody = Replace(OutMail.HTMLbody, "%TABLE_HERE%", RangetoHTML(tbleRange)) .Attachments.Add (Application.ActiveWorkbook.FullName) .Display End With On Error GoTo 0 Set OutMail = Nothing Set OutApp = Nothing With Application .ScreenUpdating = True .EnableEvents = True End With End Function 

我做了一些研究，并且遇到了一个很好的function，可以为你做所有的事情，并且想和大家一起分享！ 请参考下面的答案

Answer 1

 Function RangetoHTML(rng As Range) ' Changed by Ron de Bruin 28-Oct-2006 ' Working in Office 2000-2016 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 

我从这里得到的网站…