选择Word文档的内容，然后将其粘贴到带有VBA的Outlook正文中

问题描述：

我已经创建了一个Word模板，我需要执行以下操作:

I have a Word template created and I need to do the following:

基于该模板创建一个新文档
修改新模板的一些数据并复制其所有内容
打开Outlook并将模板粘贴到邮件正文中
将邮件发送给相应的收件人

注意:基本模板将根据其数据用于多个收件人.基本上，它与单词对应"选项卡所执行的功能几乎相同，仅是自定义的.另外，由于有收件人，因此VBA代码位于excel工作表中.

Note: The base template will be used for several recipients according to their data. Basically, it is almost the same function that the Word correspondence tab fulfills, only customized. In addition, the VBA code is in an excel sheet, since there are the recipients.

这是我所拥有的代码，一切正常，直到您到达将内容粘贴到Outlook邮件正文中的行，因为这不会粘贴内容，因此粘贴实际上不起作用.

This is the code that I have, everything works fine, until you get to the line where you should paste the content in the body of the Outlook message, since this does not paste the content, practically the paste does not work.

Sub EnviarRespuestas()
    Dim editor, OutApp, Correo As Object
    Dim i, j, celda As Integer
    Dim pag1 As Worksheet
    Set pag1 = ActiveWorkbook.Worksheets("send messages")
    wArch = "path of the template"
    celda = 11

'create Document of template
    Set objWord = CreateObject("Word.Application")
    objWord.Visible = True
    objWord.documents.Add Template:=wArch, NewTemplate:=False, DocumentType:=0

'Modify document with data of Excel
    For k = 6 To 8
        With objWord.Selection.Find
            .Text = Sheet1.Range("A" & k).Text
            .Replacement.Text = Sheet1.Range("C" & k).Text
            .Execute Replace:=2
        End With
    Next k

    objWord.Activate

'Copy content of the template modify
    objWord.Selection.WholeStory
    objWord.Selection.End = objWord.Selection.End - 1
    objWord.Selection.Copy

'validate if exists recipients in sheets of excel
    Do While Not pag1.Range("J" & celda).Value = ""
        Set Correo = OutApp.CreateItem(0)
        With Correo
            .To = pag1.Range("J" & celda).Value
            .Subject = "CURSO: " & pag1.Range("C6").Text

    'try of paste content in body 
            .BodyFormat = olFormatRichText
            Set editor = .GetInspector.WordEditor
            editor.Content.Paste

            .Display

            celda = celda + 1
        End With
    Loop
End Sub

如果有人可以帮助我，我将非常感激.

If someone can help me, I would be very grateful.

答

您几乎明白了，请在粘贴之前尝试显示.还可以看到我所做的小改动

下面的示例我正在使用

Example below I'm using wdFormatOriginalFormatting to keep the formatting of word doc and signature

    Dim Correo As Object
    Set Correo = OutApp.CreateItem(0)
    Set objWord = Correo.GetInspector.WordEditor

    With Correo
        .To = pag1.Range("J" & celda).Value
        .Subject = "CURSO: " & pag1.Range("C6").Text

        .Display 'here
         objWord.Paragraphs(1).Range. _
                PasteAndFormat Type:=wdFormatOriginalFormatting

    End With

选择Word文档的内容，然后将其粘贴到带有VBA的Outlook正文中

相关推荐