VBA Macro - Word

[gmayor]

.Importance = olImportanceNormal 'Or olImprotanceHigh Or olImprotanceLow

Apart from the spelling of the alternatives, the line should read

.Importance = 1 'Or 2 Or 0

if you want to use late binding to Outlook. Similarly olMailItem should be '2'.

As for the e-mail address, without some point of reference for where to look for the address in the document it is not possible to come up with a foolproof way of identifying the e-mail address. The code below will locate the first e-mail address in the body of the document. If that is not appropriate, tell us more about how the document is laid out, where the e-mail address is located and whether there are likley to be other e-mail addresses anywhere in the document that may cause confusion.
If you use

.Body = .Body = "Dear Whoever,"

then note that this will take out your automatic signature. If you want to write to the body use the document inspector

Option Explicit
Sub eMailActiveDocument()
Dim OL As Object
Dim olInsp As Object
Dim EmailItem As Object
Dim Doc As Document
Dim wdDoc As Document
Dim oRng As Range, oFind As Range
Dim bFound As Boolean
Dim strTo As String
Const strFind As String = "[a-zA-Z0-9\-_.]{1,}\@[a-zA-Z0-9\-_.]{1,}"

    Set Doc = ActiveDocument
    Doc.Save
    If Doc.Path = "" Then GoTo lbl_Exit
    Set oFind = Doc.Range
    strTo = ""
    With oFind.Find
        Do While .Execute(FindText:=strFind, MatchWildcards:=True)
            strTo = oFind.Text
            bFound = True
            Exit Do
        Loop
    End With
    If Not bFound Then
        MsgBox "Email address not found!"
        'Goto lbl_exit 'Optional quit
    End If
    On Error Resume Next
    'Get Outlook if it's running
    Set OL = GetObject(, "Outlook.Application")
    'Outlook wasn't running, start it from code
    If Err <> 0 Then
        Set OL = CreateObject("Outlook.Application")
    End If
    On Error GoTo err_Handler
    Set EmailItem = OL.CreateItem(0)
    With EmailItem
        .to = strTo
        .Subject = "Subject"
        .Importance = 1
        .Attachments.Add Doc.FullName
        Set olInsp = .GetInspector
        Set wdDoc = olInsp.WordEditor
        Set oRng = wdDoc.Range(0, 0)
        oRng.Text = "Dear Whoever,"
        .Display
    End With
lbl_Exit:
    Set Doc = Nothing
    Set OL = Nothing
    Set EmailItem = Nothing
    Set wdDoc = Nothing
    Set olInsp = Nothing
    Set oRng = Nothing
    Set oFind = Nothing
    Exit Sub
err_Handler:
    MsgBox Err.Number & vbCr & Err.Description
    Err.Clear
    GoTo lbl_Exit
End Sub