Excel VBA重新排列电子邮件内容

我已经在VBA中编译了以下代码来发送电子邮件。 我想发送一个表格格式的单元格的简单消息。 下面的代码工作。 但输出翻转。 我想在上面的消息文本和底部的表格。 （请看附图）。 任何时候我尝试移动任何东西，我得到一个“424对象所需”的错误。

请指教。

Sub SendEmail() Dim msg As String Set mailApp = CreateObject("Outlook.Application") Set mail = mailApp.createitem(olMailItem) msg = "Good Morning Team, " & "<br><br>" _ & "Here is this week's Coffee Talk groups. Enjoy!" & "<br><br>" With mail .To = "[e-mail]" .Subject = "Coffee Talk " & Date .HTMLBody = msg End With mail.display Set wEditor = mailApp.ActiveInspector.wordEditor ThisWorkbook.Sheets("Groups").Range("A1:E4").Copy wEditor.Application.Selection.Paste End Sub 

Answer 1

Ron de Bruin有一个Range函数可以帮助你解决问题。 我已经修改了你的代码，使其function可以工作：

 Sub SendEmail() Dim msg As String Set mailApp = CreateObject("Outlook.Application") Set mail = mailApp.createitem(olMailItem) Dim rng As Range msg = "Good Morning Team, " & "<br><br>" _ & "Here is this week's Coffee Talk groups. Enjoy!" & "<br>" Set rng = Sheets("Groups").Range("A1:E4").SpecialCells(xlCellTypeVisible) With mail .To = "[e-mail]" .Subject = "Coffee Talk " & Date .HTMLBody = msg & "<br>" & RangetoHTML(rng) .display End With End Sub 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