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!!!!! :clap: I didn't expect it to be so easy to handle Outlook text from Word via VBA.

Have a great day.

Massimo