将电子邮件正文保存到 Word 文档

Question

我的目标是将活动电子邮件的正文从 Outlook 复制到 MS Word，并将 Word 保存到指定的目标位置。

代码

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

这是正确的方法吗？

Answer 1

这是你想要做的吗？

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

您可能还想使用 ActiveWindow.Class 来避免 CurrentItem

上出现任何错误

Answer 2

你可以检查一下，如果你真的选择了一封电子邮件（在列表中或打开）并像这样复制它的格式化正文：

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

将电子邮件正文保存到 Word 文档

Save email body to Word document

vba

outlook

ms-word

office-2016