Question

我的目标是将活动电子邮件的副本和过去的内容从Outlook复制到MS 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

您可以检查是否确实选择了电子邮件（在列表中还是已打开）并按以下方式复制其格式的正文：

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

这是您要做什么吗？

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

上出现任何错误

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

2 个答案: