将模板从Excel复制到Outlook

我有一个驻扎在Excel文件中的模板。 一旦我点击了预览button，这个模板就会显示在outlook以及它的subject，to等等

我有这个代码工作正常，但不在身体领域工作。

Sub previewMail() Dim objMail, objOutLook As Object Dim rngTo, rngCC, rngBCC, rngBody As Range Dim lRow As Long Dim i As Integer Set objOutLook = CreateObject("Outlook.Application") Set objMail = objOutLook.CreateItem(0) Set main = ThisWorkbook.Sheets("Main") lRow = main.Cells(Rows.Count, 2).End(xlUp).Row For i = 11 To lRow With main Set rngTo = .Range("B" & i) Set rngBody = .Range(.Range("C10:N30"), .Range("C10:N30")) End With With objMail .To = rngTo.Value .Subject = "Sample" 'i like the rngbody to be here .HTMLBody = RangetoHTML(rngBody)' from Ron de Bruin site .Display End With Next i End Sub 

这是上述范围内的模板。

任何人都可以请帮我解决这个问题吗？ 我已经从罗恩·德·布鲁恩（Ron de Bruin）那里试过了 ，但是我不能使它工作。 这只给出了一个“不可见的表”的产品。

Answer 1

尝试Range.PasteAndFormat wdChartPicture

例

 Option Explicit Sub previewMail() Dim objMail, Main, objOutLook As Object Dim rngTo, rngCC, rngBCC, rngBody As Range Dim lRow As Long Dim i As Integer Dim wordDoc As Word.Document '<--- Set objOutLook = CreateObject("Outlook.Application") Set objMail = objOutLook.CreateItem(0) Set Main = ThisWorkbook.Sheets("Main") Set wordDoc = objMail.GetInspector.WordEditor '<--- lRow = Main.Cells(Rows.count, 2).End(xlUp).Row For i = 11 To lRow With Main Set rngTo = .Range("B" & i) Set rngBody = .Range(.Range("C10:N30"), .Range("C10:N30")) rngBody.Copy '<--- End With With objMail .To = rngTo.Value .Subject = "Sample" .Display wordDoc.Range.PasteAndFormat wdChartPicture '<--- ' Or 'wordDoc.Range.PasteAndFormat wdChartPicture & .HTMLBody = " " End With Next i End Sub 

确保将引用设置为Microsoft Outlook和Microsoft Word Object库

工具 > 参考...

Answer 2

编辑：OP已指示文本不在范围内，但在范围前的文本框中。

使用此代码来查找文本框名称：

 for i = 1 to activesheet.chartobjects.count debug.print chartobjects(i).name next i 

它会像Textbox1或什么的，然后使用（未经testing）：

 dim strBody as string Set strBody = activesheet.chartobjects("Textbox1").Value .HTMLBody = strbody