Excel 如何从outlook邮件正文复制带有超链接的文本，并以正确格式保存到word文档中

我试图运行一个代码，从邮件正文中复制可能有一些超链接的内容。我想在创建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

---

对包含文本的范围对象使用Word的Document.Hyperlinks.Add方法添加URL。请参阅：

处理电子邮件正文时使用副本和

举个简单的例子

---

请记住设置Outlook&Word库引用，工具->引用

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

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