如何从 Outlook 邮件正文中复制带有超链接的文本并以正确的格式保存到 Word 文档中答案

【问题标题】：How to copy text with hyperlinks from outlook mail body and save into a word document with correct formatting如何从 Outlook 邮件正文中复制带有超链接的文本并以正确的格式保存到 Word 文档中
【发布时间】：2019-01-08 12:48:06
【问题描述】：

我正在尝试运行一个代码，我从邮件正文中复制可能有一些超链接的内容。我想在创建word文档时保留超链接

我尝试了各种方法，例如 Selection.AutoFormat = True，但都没有成功

Dim OutlookApp As Outlook.Application
Dim OutlookNamespace As Namespace
Dim Folder As MAPIFolder
Dim OutlookMail As Variant
Dim olItems As Outlook.Items
Dim i As Integer
Dim savePath As String
Dim filePath As String

Set OutlookApp = New Outlook.Application
Set OutlookNamespace = OutlookApp.GetNamespace("MAPI")
Set Folder = OutlookNamespace.GetDefaultFolder(olFolderInbox)
Set olItems = Folder.Items
filePath = ActiveWorkbook.Path

For Each OutlookMail In olItems
    If OutlookMail.ReceivedTime >= Date - 1 Then
        Dim objWord
        Dim objDoc
        Dim objSelection
        Dim text As String
        Set objWord = CreateObject("Word.Application")
        Set objDoc = objWord.Documents.Add
        objWord.Visible = False
        Set objSelection = objWord.Selection

        text = OutlookMail.Body
        startPos = InStr(1, text, "Market Briefs")
        endPos = InStr(startPos, text, "http")
        text = Replace(Mid(text, startPos, endPos - startPos), "   ", "-")
        Set oPara1 = objDoc.Content.Paragraphs.Add
        oPara1.Range.text = text
        oPara1.Range.Font.Bold = True
        oPara1.Format.SpaceAfter = 0
        savePath = filePath & "\" & Format(Now(), "yyyy-mm-dd")

        With objDoc.Styles("Normal").ParagraphFormat
            .SpaceBefore = 0
            .SpaceBeforeAuto = False
            .SpaceAfter = 0
            .SpaceAfterAuto = False
            .LineSpacingRule = wdLineSpaceSingle
        End With

        If Len(Dir(savePath, vbDirectory)) = 0 Then
            MkDir savePath
        End If
        objDoc.SaveAs (savePath & "\ABC.docx")
        objDoc.Close

    End If
Next OutlookMail

Set Folder = Nothing
Set OutlookNamespace = Nothing
Set OutlookApp = Nothing

【问题讨论】：

您的第一步应该是将选项显式放在模块顶部，然后重复 debug.compiles 以识别代码问题并解决它们。

标签： excel vba outlook ms-word

【解决方案1】：

在处理电子邮件正文时使用 Copy & PasteAndFormat Method

快速示例是

Option Explicit
Public Sub Example()

    Dim OutlookMail As Variant
    For Each OutlookMail In ActiveExplorer.Selection

        Dim wdApp As New Word.Application

        Dim wdDoc As Word.Document
        Set wdDoc = wdApp.Documents.Add

            OutlookMail.GetInspector().WordEditor.Range.Copy

        Dim oPara1 As Word.Paragraph
        Set oPara1 = wdDoc.Content.Paragraphs.Add
            oPara1.Range.PasteAndFormat Type:=wdFormatOriginalFormatting

    Next

End Sub

记得设置 Outlook & Word library References, Tools -> References

【讨论】：

【解决方案2】：

对包含文本的 Range 对象使用 Word 的 Document.Hyperlinks.Add 方法来添加 URL。见：https://docs.microsoft.com/en-us/office/vba/api/word.hyperlinks.add

【讨论】：