PDA

View Full Version : Transferring Word Table Cell Contents to Outlook Body



Seahorses
04-29-2020, 12:54 AM
I am developing a system that assesses results in Excel and sends out emails to students. The text in the emails has to contain hyperlinks and the users will want to change the standard text blocks fairly often. Therefore, I have put the text into Table Cells in a Word Document. The Excel part of the program works fine and it is calling the right cell content in the Word document. The problem is that I cannot copy and paste or transfer just the content
the cell (keeping the original hyperlinks in the text but not the cell itself) into the body of the automatically created email message. I have managed to get it to place the text from the Word cell into the email but this loses the hyperlinks. I have also tried Inspector and WordEditor related code but this does not seem work either (perhaps I am missing something). If someone could please give me some advice it will be very much appreciated. Thank you in advance for your assistance.

gmayor
05-01-2020, 08:38 PM
The following will work

Sub Send_Cell()
'Graham Mayor - https://www.gmayor.com - Last updated - 02 May 2020
'Send the formatted content of a table cell in an Outlook Email message
'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 olApp As Object
Dim oItem As Object
Dim oTable As Table
Dim olInsp As Object
Dim wdDoc As Document
Dim oRng As Range, oCell As Range

Set oTable = ActiveDocument.Tables(1)
Set oCell = oTable.Cell(1, 1).Range
'eliminate cell end character
oCell.End = oCell.End - 1
'copy cell content
oCell.Copy

'Get Outlook
Set olApp = OutlookApp()
On Error GoTo 0

'Create a new mailitem
Set oItem = olApp.CreateItem(0)

With oItem
.Subject = "This is the subject"
.BodyFormat = 2
Set olInsp = .GetInspector
Set wdDoc = olInsp.WordEditor
Set oRng = wdDoc.Range
'cursor to the start
oRng.Collapse 1
'paste the cell content
oRng.Paste
oRng.Collapse 0
oRng.Text = " this is text after the cell content" & vbCr & vbCr
oRng.Collapse 0
'copy another cell
Set oCell = oTable.Cell(1, 2).Range
'eliminate cell end character
oCell.End = oCell.End - 1
'copy cell content
oCell.Copy
oRng.Paste
.Display
End With
'delete the temporary file
lbl_Exit:
Set oItem = Nothing
Set olApp = Nothing
Set olInsp = Nothing
Set oRng = Nothing
Set wdDoc = Nothing
Exit Sub
End Sub

Seahorses
05-02-2020, 06:24 PM
Dear Graham, Many thanks. With just a little tweaking (so it meshed with the rest of the program) this works a treat. Your assistance is, therefore, very much appreciated, as I had wasted hours seeking an appropriate solution.:clap::)