Sub SaveAsWordDoc()
    Dim objMail As MailItem
    
    On Error Resume Next
    
    Set objMail = ActiveExplorer.Selection.Item(1)
    If Not objMail Is Nothing Then
        Dim objWdDoc As Object
        Set objWdDoc = CreateObject("Word.Document")
        With objWdDoc
            .content = objMail.Subject & vbCr & _
						objMail.Body
            .Save
            .Close
        End With
    End If
End Sub