Select the content of Word document and paste it i

问题:

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

1. Create a new document based on that template
2. Modify some data of the new template and copy all its contents
3. Open Outlook and paste the template into the body of the message
4. Send the message to the corresponding recipient

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.

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.

回答1:

You almost got it, try to display before you paste it. Also see the little changes I made

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