Sub SendDocAsMsg()
    Dim wd As Word.Application
    Dim doc As Word.Document
    Dim itm As Object
    Dim ID As String
    Dim blnWeOpenedWord As Boolean
    On Error Resume Next
    
    Set wd = GetObject(, "Word.Application")
    If wd Is Nothing Then
        Set wd = CreateObject("Word.Application")
        blnWeOpenedWord = True
    End If
    Set doc = wd.Documents.Open _
      (FileName:="C:\Current.doc", ReadOnly:=True)
    Set itm = doc.MailEnvelope.Item
    With itm
        .To = "Address"
        .Subject = "Subject"
        .Save
        ID = .EntryID
    End With
    Set itm = Nothing
    
    Set itm = Application.Session.GetItemFromID(ID)
    itm.Send
    doc.Close wdDoNotSaveChanges
    If blnWeOpenedWord Then
        wd.Quit
    End If
    
    Set doc = Nothing
    Set itm = Nothing
    Set wd = Nothing
End Sub