Consulting

Results 1 to 10 of 10

Thread: Export Word Table into Outlook Email Body

  1. #1
    VBAX Regular
    Joined
    May 2009
    Posts
    76
    Location

    Export Word Table into Outlook Email Body

    How can I edit the following code, in-which copies a table to clipboard, and then the coiped table iinserted into an outlook email body.

    Private Sub CommandButton4_Click()
    With ActiveDocument
        .Tables(1).Range.Copy
        .Range(1, 1).Select
    ActiveDocument.Tables(1).Cell(2, 1).Select
      
      
    End With
    End Sub
    Currently using word 2010 and outlook professional plus 2010

  2. #2
    The following should do that. You can replace the subject, the texts and the recipient as required:

    Private Sub CommandButton4_Click()
    Dim olApp As Object
    Dim oMail As Object
    Dim olInsp As Object
    Dim wdDoc As Object
    Dim oRng As Object
    
        On Error Resume Next
        If ActiveDocument.Tables.Count > 0 Then
            ActiveDocument.Tables(1).Range.Copy
            Set olApp = GetObject(, "Outlook.Application")
            If Err <> 0 Then
                Set olApp = CreateObject("Outlook.Application")
            End If
            'On Error GoTo lbl_Exit
            Set oMail = olApp.CreateItem(0)
            With oMail
                .to = "someone@somewhere.com"
                .Subject = "Message Subject"
                .BodyFormat = 2
                Set olInsp = .GetInspector
                Set wdDoc = olInsp.WordEditor
                Set oRng = wdDoc.Range(0, 0)
                .Display        'This line is required.
                oRng.Text = "This is the text before the table." & vbCr & vbCr
                oRng.Collapse 0
                oRng.Paste
                oRng.Collapse 0
                oRng.Text = vbCr & "This is the text after the table, before the signature."
                '.Send  'Restore this line to send the message
            End With
        Else
            MsgBox "No table!"
        End If
        ActiveDocument.Tables(1).Cell(2, 1).Select
    lbl_Exit:
        Set olApp = Nothing
        Set olInsp = Nothing
        Set wdDoc = Nothing
        Set oRng = 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
    May 2009
    Posts
    76
    Location
    Great works perfectly.

    How can i copy cell (2 and 4) from row (2) and insert into the .subject line. I tried tinkering around with the following and few other variations but it only picks up the first or last cell only and not both.

    .Subject = ActiveDocument.Tables(1).Cell(2, 2).Range & .Subject = ActiveDocument.Tables(1).Cell(2, 4).Range
    Last edited by Aussiebear; 04-25-2023 at 03:19 PM. Reason: Added code tags

  4. #4
    Presumably these cells are in the table being copied? That being the case add a couple of declarations at the top
    Dim oCell As Range
    Dim strSubject As String
    Modify the code as follows
    If ActiveDocument.Tables.Count > 0 Then
            Set oCell = ActiveDocument.Tables(1).Cell(2, 2).Range
            oCell.End = oCell.End - 1 'remove the cell end character
            strSubject = oCell.Text
            Set oCell = ActiveDocument.Tables(1).Cell(2, 4).Range
            oCell.End = oCell.End - 1'remove the cell end character
            'Add the cell text to the subject string
            strSubject = strSubject & Chr(32) & oCell.Text
    and insert the subject string into the message
    .Subject = strSubject
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  5. #5

    Export Word Table into Outlook Email Body without table border

    Please advise if the code can be revised to remove the border that is displayed around the table in the body of the email.

  6. #6
    Add another value to the Dim statements
    Dim oBorder As Object
    Then add the following where shown

    oRng.Text = vbCr & "This is the text after the table, before the signature."
    '.Send 'Restore this line to send the message
    With wdDoc.Tables(1)
    For Each oBorder In .Borders
    oBorder.LineStyle = 0
    Next oBorder
    End With

    End With
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  7. #7

    Adding a dropdown for which table number to copy for emailing.

    I have this code working and can change ActiveDocument.Tables(1).Range.Copy with any number in the ( ) to select that table from the document to send in the email. I would like a drop down to open when the macro is run to allow selection of which table to be copied. This could simply be by number or a nickname (preferred), then that number would populate ActiveDocument.Tables(x).Range.Copy and copy the correct table into the email body. TIA.

  8. #8
    This is an old thread and it would have been advisable to start a new one, however. If you want to select from a list of tables, then bookmark the tables with suitable names.

    Create a simple userform with a combo box and a command button - https://www.gmayor.com/Userform.htm

    The code for the userform is

    Option Explicit
    
    Private Sub CommandButton1_Click()
        Hide
    End Sub
    Then use the following code to call the userform and create the message. Note especially the comment at the top of the code as it won't work otherwise.

    Note the userform uses the default names here for the form and its controls. If you need to change them, you will have to change them in the code also.

    Option Explicit
    
    Private Sub Macro1()
    'Graham Mayor - https://www.gmayor.com - Last updated - 20 Dec 2019
    'This macro requires the code from the following link to open Outlook correctly
    'http://www.rondebruin.nl/win/s1/outlook/openclose.htm
    
    
    Dim olApp As Object
    Dim oMail As Object
    Dim olInsp As Object
    Dim wdDoc As Object
    Dim oRng As Object
    Dim oFrm As UserForm1
    Dim lngTable As Long
    Dim oBM As Bookmark
    
    
        On Error Resume Next
        If ActiveDocument.Tables.Count > 0 Then
    
    
            Set oFrm = New UserForm1
            With oFrm
                .ComboBox1.AddItem "[Select Table]"
                For Each oBM In ActiveDocument.Bookmarks
                    If oBM.Range.Tables.Count > 0 Then
                        .ComboBox1.AddItem oBM.Name
                    End If
                Next oBM
                .ComboBox1.ListIndex = 0
                .Show
                If .ComboBox1.ListIndex < 1 Then
                    MsgBox "No table selected"
                    GoTo lbl_Exit
                End If
                lngTable = .ComboBox1.ListIndex
            End With
            Unload oFrm
    
    
            ActiveDocument.Tables(lngTable).Range.Copy
            Set olApp = OutlookApp()
            On Error GoTo 0
            Set oMail = olApp.CreateItem(0)
            With oMail
                .to = "someone@somewhere.com"
                .Subject = "Message Subject"
                .BodyFormat = 2
                Set olInsp = .GetInspector
                Set wdDoc = olInsp.WordEditor
                Set oRng = wdDoc.Range(0, 0)
                .Display        'This line is required.
                oRng.Text = "This is the text before the table." & vbCr & vbCr
                oRng.Collapse 0
                oRng.Paste
                oRng.Collapse 0
                oRng.Text = vbCr & "This is the text after the table, before the signature."
            End With
            '.Send  'Restore this line to send the message
        Else
            MsgBox "No table!"
        End If
    lbl_Exit:
        Set olApp = Nothing
        Set olInsp = Nothing
        Set wdDoc = Nothing
        Set oRng = Nothing
        Set oFrm = 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

  9. #9
    VBAX Newbie
    Joined
    Nov 2022
    Posts
    1
    Location
    Hi gmayor

    I just stumbled upon this thread and the original code is almost exactly what I am looking for in one of my projects and I was wondering if you could possibly help please.

    I was trying to update the code to send multiple tables, for example in my code I would like to take tables 1 , 2, 8 & 9 and drop into the body of the email, but every time I tried kept getting errors .

    Also is it possible to add a line of code to attach the active document to the email and name the subject of the email the active name?

    If you could advice that would be amazing as I'm quite the macro novice.

  10. #10
    Maybe something like

    Option Explicit
    
    Private Sub Macro1()
    'Graham Mayor - https://www.gmayor.com - Last updated - 29 Nov 2022
    'This macro requires the code from the following link to open Outlook correctly
    'http://www.rondebruin.nl/win/s1/outlook/openclose.htm
    
    
    Dim olApp As Object
    Dim oMail As Object
    Dim olInsp As Object
    Dim wdDoc As Object
    Dim oDoc As Document
    Dim oRng As Object
    Dim lngTable As Long
    Dim oBM As Bookmark
    
    
        On Error Resume Next
        If ActiveDocument.Tables.Count > 4 Then
            Set oDoc = ActiveDocument
            oDoc.Save
            Set olApp = OutlookApp()
            On Error GoTo 0
            Set oMail = olApp.CreateItem(0)
            With oMail
                .to = "someone@somewhere.com"
                .Subject = oDoc.Name
                .BodyFormat = 2
                .Attachments.Add oDoc.FullName
                Set olInsp = .GetInspector
                Set wdDoc = olInsp.WordEditor
                Set oRng = wdDoc.Range(0, 0)
                .Display        'This line is required.
                oRng.Text = "This is the text before the tables." & vbCr & vbCr
                oRng.Collapse 0
                For lngTable = 1 To 9
                    If lngTable = 1 Then
                        oDoc.Tables(lngTable).Range.Copy
                        oRng.Paste
                        oRng.Collapse 0
                        oRng.Text = "Table " & lngTable & vbCr
                        oRng.Collapse 0
                    End If
                    If lngTable = 2 Then
                        oDoc.Tables(lngTable).Range.Copy
                        oRng.Paste
                        oRng.Collapse 0
                        oRng.Text = "Table " & lngTable & vbCr
                        oRng.Collapse 0
                    End If
                    If lngTable = 8 Then
                        oDoc.Tables(lngTable).Range.Copy
                        oRng.Paste
                        oRng.Collapse 0
                        oRng.Text = "Table " & lngTable & vbCr
                        oRng.Collapse 0
                    End If
                    If lngTable = 9 Then
                        oDoc.Tables(lngTable).Range.Copy
                        oRng.Paste
                        oRng.Collapse 0
                        oRng.Text = "Table " & lngTable & vbCr
                        oRng.Collapse 0
                    End If
                Next lngTable
                oRng.Text = vbCr & "This is the text after the tables, before the signature."
            End With
            '.Send  'Restore this line to send the message
        Else
            MsgBox "No tables!"
        End If
    lbl_Exit:
        Set olApp = Nothing
        Set oDoc = Nothing
        Set olInsp = Nothing
        Set wdDoc = Nothing
        Set oRng = 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

Posting Permissions

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