Выберите содержимое документа Word и вставьте его в тело Outlook с помощью VBA.

Question

У меня создан шаблон Word, и мне нужно сделать следующее:

1. Создать новый документ на основе этого шаблона
2. Изменить некоторые данные нового шаблона и скопировать всеего содержимое
3. Откройте Outlook и вставьте шаблон в тело сообщения
4. Отправьте сообщение соответствующему получателю

Примечание. Будет использован базовый шаблондля нескольких получателей по их данным.По сути, это почти та же функция, которую выполняет вкладка соответствия Word, только настраиваемая.Кроме того, код VBA находится в листе Excel, так как есть получатели.

Это код, который у меня есть, все работает нормально, пока вы не дойдете до строки, где вы должны вставить содержимое втело сообщения Outlook, поскольку оно не вставляет содержимое, практически вставка не работает.

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

Если кто-то может мне помочь, я был бы очень признателен.

Answer 1

Вы почти получили его, попробуйте отобразить, прежде чем вставить его.Также обратите внимание на небольшие изменения, которые я сделал

Пример ниже Я использую wdFormatOriginalFormatting , чтобы сохранить форматирование слова doc и подписи

    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