Save email body to Word document - vba

Question

My goal is copy and past body of active email from Outlook to the MS Word, and save Word to specified destination.
Code
Dim objMail as Outlook.MailItem
Dim objWord As Object
Dim objDocument As Object
Dim objFSO As Object
Dim objTextStream As Object
Set objMail = Application.ActiveInspector.CurrentItem
Set objWord = CreateObject("Word.Application")
Set objDocument = objWord.Documents.Add
objMail.GetInspector().WordEditor.Range.FormattedText.Copy
objDocument.Range.Paste
Its a right way ?

Answer 1

You can check, if you really selected an email (either within the list or opened) and copy its formatted body like this:
Private Sub CopyEMailBodyToWord()
Dim objOutlook As Outlook.Application
Dim objMail As Object 'Outlook.MailItem, but has to be checked later
Dim objWord As Object
Dim objDocument As Object
Set objOutlook = Outlook.Application
Select Case TypeName(objOutlook.ActiveWindow)
Case "Explorer" ' get current item in list view
Set objMail = objOutlook.ActiveExplorer.Selection.Item(1)
Case "Inspector" ' get open item
Set objMail = objOutlook.ActiveInspector.CurrentItem
End Select
If objMail.Class = olMail Then
Set objWord = GetObject(, "Word.Application")
If objWord Is Nothing Then Set objWord = CreateObject("Word.Application")
Set objDocument = objWord.Documents.Add
' copy formatted body:
objMail.GetInspector.WordEditor.Range.FormattedText.Copy
objDocument.Range.Paste
' or copy text only:
'objDocument.Range.Text = objMail.Body
With objWord.FileDialog(msoFileDialogSaveAs)
.Title = "Save ..."
.InitialFileName = objWord.Options.DefaultFilePath(wdDocumentsPath) & _
"\" & objMail.Subject & ".docx"
If .Show <> False Then
objDocument.SaveAs _
FileName:=.SelectedItems(1), _
AddToMru:=False
End If
End With
End If
End Sub

Answer 2

Is this what you are trying to do?
Option Explicit
Public Sub Example()
Dim Email As Outlook.MailItem
Set Email = Application.ActiveInspector.CurrentItem
'Word document
Dim wdApp As Word.Application
Set wdApp = CreateObject("Word.Application")
Dim wdDoc As Word.Document
Set wdDoc = wdApp.Documents.Add
wdDoc.Activate
Dim wdRange As Word.Range
Set wdRange = wdDoc.Range(0, 0)
'Add email to the document
wdRange.Text = Email.Body
wdApp.Visible = True
wdDoc.SaveAs2 FileName:="C:\Temp\Example.docx", FileFormat:= _
wdFormatXMLDocument, CompatibilityMode:=15
End Sub
You may also wanna work with ActiveWindow.Class to avoid any error on your CurrentItem