Question

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。

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

Answer 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

Answer 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

Answer 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

使用Excel VBA将OLE WorkScript的内容放入Outlook电子邮件的正文中

3 个答案: