Consulting

Results 1 to 3 of 3

Thread: Transferring Word Table Cell Contents to Outlook Body

  1. #1
    VBAX Regular
    Joined
    Apr 2020
    Location
    Perth, Western Australia
    Posts
    6
    Location

    Transferring Word Table Cell Contents to Outlook Body

    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.

  2. #2
    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
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  3. #3
    VBAX Regular
    Joined
    Apr 2020
    Location
    Perth, Western Australia
    Posts
    6
    Location
    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.

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •