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
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.Option Explicit Private Sub CommandButton1_Click() Hide End Sub
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




Reply With Quote