使用 Excel VBA 将 Excel 工作簿中的 OLEObject 内容放入 Outlook 电子邮件正文答案

【问题标题】：Put contents of OLEObject from Excel Workbook into body of Outlook email using Excel VBA使用 Excel VBA 将 Excel 工作簿中的 OLEObject 内容放入 Outlook 电子邮件正文
【发布时间】：2018-02-15 23:52:31
【问题描述】：

OLEObject 是一个 Microsoft Word 文档对象。我希望文件的内容作为正文中的文本。 Word 文档还包含一个图像。

执行此操作的代码行有问题：

Option Explicit
Sub Genera_email()
    Dim App As Object
    Dim MailItem As Object
    Set App = CreateObject("Outlook.Application")
    Set MailItem = App.CreateItem(0)
    With MailItem
        .BCC = Selection.Value
        .Subject = "Text object"
        .Body = Worksheets(2).OLEObjects(1) ' the problem line
        .Display
    End With
    Set MailItem = Nothing
    Set App = Nothing
    Selection.Offset(0, 1).Select
    Selection.Value = "V"
    Selection.Offset(1, -1).Select
End Sub

我使用 Microsoft Office 2016。

这行代码的正确语法是什么？

【问题讨论】：

我猜你想要电子邮件正文中的 Word 文档文本。尝试使用 VBA 打开文档，然后选择文本并将其粘贴到电子邮件正文中。另一种选择是attach the word file to the e.mail
stackoverflow.com/a/44599739/4539709
我不想要电子邮件中的附件，我想要内容文件作为正文中的文本。 word文档还包含一张图片。

标签： excel vba email outlook

【解决方案1】：

如果您想将内容放在正文中，则必须将文件复制到临时文件夹中，并在使用新对象打开后，复制内容并粘贴到正文中。要将 OLEobject 保存在文件夹中，您可以使用如下代码：

Worksheets(2).OLEObjects(1).Copy    
CreateObject("Shell.Application").Namespace(ActiveWorkbook.Path).Self.InvokeVerb "Paste"

然后创建 Microsoft Word 文档对象并复制内容。

如果你想附加。

 Option Explicit
Sub Genera_email()
    Dim App As Object
    Dim MailItem As Object
    Set App = CreateObject("Outlook.Application")
    Set MailItem = App.CreateItem(0)
    With MailItem
        .BCC = Selection.Value
        .Subject = "Text object"
        .Body = "Say Hello"
        .Attachments.Add Worksheets(2).OLEObjects(1)
        .Display
    End With
    Set MailItem = Nothing
    Set App = Nothing
    Selection.Offset(0, 1).Select
    Selection.Value = "V"
    Selection.Offset(1, -1).Select
End Sub

【讨论】：

我已经有了 Body.docx 文件，我必须将内容粘贴到正文中，而不是作为附件。

【解决方案2】：

试试这个：

Option Explicit
Sub Genera_email()
Dim strFile As String
Dim strbody As String
strFile = ActiveWorkbook.Path & "\Body.docx"
Dim objWordapp As Object, objWordDoc As Object
Set objWordapp = CreateObject("word.Application")
objWordapp.Visible = True
Set objWordDoc = objWordapp.documents.Open(strFile)
strbody = objWordDoc.Content
objWordDoc.Close
objWordapp.Quit

Dim App As Object
    Dim MailItem As Object
    Set App = CreateObject("Outlook.Application")
    Set MailItem = App.CreateItem(0)
    With MailItem
        .BCC = Selection.Value
        .Subject = "Text object"
        .body = strbody
        .Display
    End With
    Set MailItem = Nothing
    Set App = Nothing
    Selection.Offset(0, 1).Select
    Selection.Value = "V"
    Selection.Offset(1, -1).Select


End Sub

【讨论】：

【解决方案3】：

我解决了！！！ :-D

Private Sub SendEmail()
    Dim Outlook, Word As Object
    Set Outlook = CreateOutlook()
    Set Word = CreateObject("Word.Application")
    Word.Documents.Open(ActiveWorkbook.Path & "\Body.docx", ReadOnly:=True).Content.Copy
    Sleep 0.01
    Do While Start And Selection.Value <> ""
        With Outlook.CreateItem(0)
            .To = Selection.Value
            .Subject = "Text subject"
            .GetInspector.WordEditor.Content.Paste
            .Display
            .Send
        End With
        If IsSent() Then Selection.Offset(0, 1) = "V" Else Selection.Offset(0, 1) = "X"
        Selection.Offset(1, 0).Select
        Sleep 0.01
    Loop
    Word.Quit
    Set Outlook = Nothing
    Set Word = Nothing
End Sub

【讨论】：