Sub Send_As_HTML_EMail()
Dim bStarted As Boolean
Dim olApp As Object
Dim oItem As Object
Dim oTable As Table
Dim orng As Range
Dim objdoc As Object
Dim objSel As Selection
Dim sSubject As String
Dim sTo As String
    On Error Resume Next
    Set oTable = ActiveDocument.Tables(1)
    'set the range to the first required cell
    Set orng = oTable.Cell(1, 1).Range    'range 'row1, column 1
    orng.End = orng.End - 1    'remove cell end character
    sSubject = orng.Text
    'Move the range to the next required cell
    Set orng = oTable.Cell(2, 1).Range    'range 'row2, column 1
    orng.End = orng.End - 1    'remove cell end character
    sTo = orng.Text
    'Move the range to the whole table
    Set orng = oTable.Range
    orng.Copy    'copy the table
    'Get Outlook if it's running
    Set olApp = GetObject(, "Outlook.Application")
    If Err <> 0 Then
        'Outlook wasn't running, start it from code
        Set olApp = CreateObject("Outlook.Application")
        bStarted = True
    End If
    'Create a new mailitem
    Set oItem = olApp.CreateItem(0)
    With oItem
        .BodyFormat = 2
        .Display
        Set objdoc = .GetInspector.WordEditor
        Set objSel = objdoc.Windows(1).Selection
        objSel.Paste
        .to = sTo
        .Subject = sSubject
        .Send
    End With
    If bStarted Then
        'If we started Outlook from code, then close it
        olApp.Quit
    End If
    'Clean up
    Set oItem = Nothing
    Set olApp = Nothing
lbl_Exit:
    Exit Sub
End Sub