Table in word into outlook Message

[Tezzies]

Hello,

I only seem to be able to get the text from the table, be great if anyone new a method of pasting in the table with formatting.

Many Thanks

Tez

[gmayor]

Provided the message format is html, use the paste option 'with source formatting'

28645

[Tezzies]

Thanks but I'm trying to use Word to create an email then copy and paste a table from word into the email using VBA.

[gmayor]

OK, but without knowing what you are copying and where from and what else is in the message, it is difficult to be exact. However the following will copy the first table in the current document to the start of an e-mail message with text before and after.If you are familiar with vba ranges in Word, you should be able to edit he message body as required.

Note the comment at the top of the macro. It won't work without that code.


Sub Send_As_HTML_EMail()
'Graham Mayor - http://www.gmayor.com - Last updated - 14 Jul 2017
'Requires the code from http://www.rondebruin.nl/win/s1/outlook/openclose.htm
'to either retrieve an open instance of Outlook or open Outlook if it is closed.
Dim bStarted As Boolean
Dim OlApp As Object
Dim oItem As Object
Dim strRecipient As String
Dim strSubject As String
Dim olInspector As Object
Dim wdDoc As Document, oSource As Document
Dim oRng As Range

strRecipient = "someone@somewhere.com"
strSubject = "This is the message subject"

Set oSource = ActiveDocument
oSource.Tables(1).Range.Copy

Set OlApp = OutlookApp()
Set oItem = OlApp.CreateItem(0)
With oItem
.BodyFormat = 2
.To = strRecipient
.Subject = strSubject
.Display 'Required!
Set olInspector = .GetInspector
Set wdDoc = olInspector.WordEditor
Set oRng = wdDoc.Range
With oRng
.Collapse 1
.Text = "Dear Sir" & vbCr & vbCr & "This is the text that goes before the table" & vbCr & vbCr
.Collapse 0
.Paste
.Collapse 0
.Text = vbCr & vbCr & "This is the text that goes after the table." & vbCr & vbCr & "But before the signature."
End With
'.Send 'enable after testing
End With
lbl_Exit:
Set oItem = Nothing
Set OlApp = Nothing
Set wdDoc = Nothing
Set oRng = Nothing
Set oSource = Nothing
Exit Sub
End Sub