如何保存显示原始超链接文本的电子邮件

Question

我们收到来自第三方的自动电子邮件，其中包含隐藏形式的超链接（链接显示的是其他文本而不是地址）。
我们希望通过执行脚本的规则自动将原始链接导出到文本文件或 Outlook 之外的其他介质中。

这不起作用：

Sub ShowAllHyperlinkAddresses(objMail As Outlook.MailItem)
Dim objItem As Object

Dim iCount As Integer
Dim Links As String
Dim objWordDocument As Word.Document

Set objHyperlinks = objWordDocument.Hyperlinks
Dim objHyperlink As Word.Hyperlink

For Each objItem In ActiveExplorer.CurrentFolder.Items
    iCount = iCount + 1
Next

If objHyperlinks.Count > 0 Then
    For Each objHyperlink In objHyperlinks
        strLink = objHyperlink.Address
        strLink = vbTab & "<" & strLink & ">"
        Links = Links & strLink
    Next
End If
        
Set objFileToWrite = CreateObject(“Scripting.FileSystemObject”)

objFileToWrite.OpenTextFile ("C:\Users\Wesley\Desktop" & CStr(iCount) & ".txt")
objFileToWrite.WriteLine Links
objFileToWrite.Close
objFileToWrite = Nothing

End Sub

我的主要目标是最终得到一个包含原始超链接的文本文件。
我们不关心文件名或类似的东西，因为文件将在保存后不久被删除。

编辑/更新：
我的团队使用 Python 3 和 win32com 整理出了我们需要的东西。

import win32com.client

outlook = 
win32com.client.Dispatch("Outlook.Application").GetNamespace("MAPI")
folder = outlook.Folders("YOUR_EMAIL_HERE")
inbox = folder.Folders("Inbox")
msg = inbox.Items
msgs = msg.GetLast()
body = msgs.body

links = re.findall(r'(https?://\S+)', body)

提取最近的电子邮件并获取其链接。

Answer 1

您需要从收到的项目中获取 Word Document 类的实例：

Sub ShowAllHyperlinkAddresses(objMail As Outlook.MailItem)
  Dim iCount As Integer
  Dim Links As String
  Dim objWordDocument As Word.Document

  Set objWordDocument = objMail.GetInspector().WordEditor

  Set objHyperlinks = objWordDocument.Hyperlinks
  Dim objHyperlink As Word.Hyperlink

  If objHyperlinks.Count > 0 Then
       For Each objHyperlink In objHyperlinks
           strLink = objHyperlink.Address
           strLink = vbTab & "<" & strLink & ">"
           Links = Links & strLink
       Next
  End If

  iCount = ActiveExplorer.CurrentFolder.Items.Count

  Set objFileToWrite = CreateObject(“Scripting.FileSystemObject”)

  objFileToWrite.OpenTextFile ("C:\Users\Wesley\Desktop" & CStr(iCount) & ".txt")
  objFileToWrite.WriteLine Links
  objFileToWrite.Close
  objFileToWrite = Nothing

End Sub