Sub Send_Extract_As_EMail()
'Graham Mayor - https://www.gmayor.com - Last updated - 20 Apr 2021 
'Requires the code - 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 outNS As Object
Dim objDoc As Word.Document
Dim objSel As Selection
Dim strEmail As String
    strEmail = "<PR_EMAIL_ADDRESS>"
    'Let the user choose the contact from Outlook
    'And assign the email address to a variable

    strEmail = Application.GetAddress("", strEmail, _
                                      False, 1, , , True, True)
    If strEmail = "" Then
        MsgBox "User cancelled or no address listed", , "Cancel"
        GoTo lbl_Exit
    End If

    Set OlApp = OutlookApp()

    'Create a new mailitem
    Set outNS = OlApp.GetNamespace("MAPI")
    outNS.logon
    Set oItem = OlApp.CreateItem(0)
    Set objDoc = oItem.GetInspector.WordEditor
    Set objSel = objDoc.Windows(1).Selection
    With oItem
        .To = strEmail
        .Subject = InputBox("Subject?")
        Selection.Copy
        .Display
        objSel.Paste
    End With

lbl_Exit:
    'Clean up
    Set oItem = Nothing
    Set OlApp = Nothing
    Set objSel = Nothing
    Set outNS = Nothing
    Set objDoc = Nothing
    Exit Sub
End Sub