.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