Copy Word Contents to Email

[max76]

Hi everyone,

I've got a word document and I need to copy a table and past it into an email message. That's what the outgoing email must look like:

--------------------------------------------------------------------------------
Dear ***,

some test in this portion......

PASTE TABLE from the active document

► more text here ◄

SIGNATURE
--------------------------------------------------------------------------------

In the attached file you can see the code that I've used. It allows me to add the text at the beginning, paste the table after that but I can't figure out how to add text below the table.

Thank you in advance for your support.

Regards
Massimo

[gmayor]

You code is almost there however what you need is as follows. This part of the code does not need to be in the ThisDocument module and should be in an ordinary module - though it will work. Note the comments in the macro code.

Option Explicit
'This macro requires the code from http://www.rondebruin.nl/win/s1/outlook/openclose.htm
'to open Outlook correctly

Sub SendtoEmail()
Dim OutApp As Object
Dim OutMail As Object
Dim wdDoc As Document
Dim oRng As Range
Dim oTable As Range
Dim strText1 As String
Dim strText2 As String

    strText1 = "Dear " & ActiveDocument.SelectContentControlsByTag("Recipient").Item(1).Range.Text & "," & vbCr & vbCr & _
               "This is another line of text before the table"
    strText2 = "This is the text after the table" & vbCr & vbCr & _
               "This is another line of text after the table"
    Set oTable = ActiveDocument.Tables(1).Range
    oTable.Copy
    Set OutApp = OutlookApp()
    Set OutMail = OutApp.CreateItem(0)    'code from http://www.rondebruin.nl/win/s1/outlook/openclose.htm

    With OutMail
        .To = "test@moneygram.com"
        .CC = "salesrep@moneygram.com"
        .Subject = "Test"
        Set wdDoc = OutMail.GetInspector.WordEditor
        .Display 'do not delete
        Set oRng = wdDoc.Range
        With oRng
            .Collapse 1
            .Text = strText1 & vbCr & vbCr
            .Collapse 0
            .Paste
            .Collapse 0
            .Text = vbCr & strText2
        End With
        '.Send 'enable after testing
    End With
    Set OutApp = Nothing
    Set OutMail = Nothing
    Set wdDoc = Nothing
    Set oRng = Nothing
    Set oTable = Nothing
End Sub

[max76]

Hi Graham,

thank you so much for your code! Is there a way to format the text in the email? I need to set a few words to bold.

Thank you!

Massimo

[gmayor]

You can format the text in exactly the same was that you can format any Word range in Word VBA. e.g.

       With oRng
            .Collapse 1
            .Text = strText1 & vbCr & vbCr
            .Words(1).Font.Bold = True
            .Words(2).Font.Bold = True
            .Collapse 0
            .Paste
            .Collapse 0
            .Text = vbCr & strText2
            .Font.Size = 14
            .Font.Italic = True
            .Font.Color = RGB(0, 0, 255)
        End With

[max76]

Hi Graham,

thank you very much again for your prompt reply. It worked perfectly!!!!! I didn't expect it to be so easy to handle Outlook text from Word via VBA.

Have a great day.

Massimo