Note: The other languages of the website are Google-translated. Back to English

Outlook:如何从一封电子邮件中提取所有 URL

如果一封电子邮件包含数百个需要提取到文本文件的 URL,那么逐个复制和粘贴将是一项繁琐的工作。 本教程介绍了可以快速从电子邮件中提取所有 URL 的 VBA。

VBA 从一封电子邮件中提取 URL 到文本文件

VBA 从多封电子邮件中提取 URL 到 Excel 文件

Office选项卡-在Office中启用选项卡式编辑和浏览,并使工作更加容易...
Kutools for Outlook-为Microsoft Outlook带来100种强大的高级功能
  • 自动CC / BCC 根据规则发送电子邮件; 自动转发 按规则发送多封电子邮件; 自动回复 没有交换服务器,还有更多自动功能...
  • BCC警告 -如果您的邮件地址在密件抄送列表中,则当您尝试全部答复时显示消息; 缺少附件时提醒,还有更多提醒功能...
  • 回复(全部)带有所有附件 在邮件对话中; 一次回复许多电子邮件; 自动添加问候语 回复时自动将日期和时间添加到主题中...
  • 附件工具:自动分离,全部压缩,重命名,自动保存所有... 快速报告,计算所选邮件, 删除重复的邮件和联系人...
  • 超过100种高级功能将 解决您的大部分问题 在Outlook 2010-2019和365中提供。全功能60天免费试用。

VBA 从一封电子邮件中提取 URL 到文本文件

 

1. 选择您要提取 URL 的电子邮件,然后按 其他 + F11 启用键 Microsoft Visual Basic应用程序 窗口。

2。 点击 插页 > 模块 创建一个新的空白模块,然后将以下代码复制并粘贴到模块中。

VBA:将一封电子邮件中的所有 URL 提取到文本文件中。

Sub ExportUrlToTextFileFromEmail()
'UpdatebyExtendoffice20220413
  Dim xMail As Outlook.MailItem
  Dim xRegExp As RegExp
  Dim xMatchCollection As MatchCollection
  Dim xMatch As Match
  Dim xUrl As String, xSubject As String, xFileName As String
  Dim xFs As FileSystemObject
  Dim xTextFile As Object
  Dim i As Integer
  Dim InvalidArr
  On Error Resume Next
  If Application.ActiveWindow.Class = olInspector Then
    Set xMail = ActiveInspector.CurrentItem
  ElseIf Application.ActiveWindow.Class = olExplorer Then
    Set xMail = ActiveExplorer.Selection.Item(1)
  End If
  Set xRegExp = New RegExp
  With xRegExp
    .Pattern = "(https?[:]//([0-9a-z=\?:/\.&-^!#$;_])*)"
    .Global = True
    .IgnoreCase = True
  End With
  If xRegExp.test(xMail.Body) Then
    InvalidArr = Array("/", "\", "*", ":", Chr(34), "?", "<", ">", "|")
    xSubject = xMail.Subject
    For i = 0 To UBound(InvalidArr)
      xSubject = VBA.Replace(xSubject, InvalidArr(i), "")
    Next i
    xFileName = "C:\Users\Public\Downloads\" & xSubject & ".txt"
    Set xFs = CreateObject("Scripting.FileSystemObject")
    Set xTextFile = xFs.CreateTextFile(xFileName, True)
    xTextFile.WriteLine ("Export URLs:" & vbCrLf)
    Set xMatchCollection = xRegExp.Execute(xMail.Body)
    i = 0
    For Each xMatch In xMatchCollection
      xUrl = xMatch.SubMatches(0)
      i = i + 1
      xTextFile.WriteLine (i & ". " & xUrl & vbCrLf)
    Next
    xTextFile.Close
    Set xTextFile = Nothing
    Set xMatchCollection = Nothing
    Set xFs = Nothing
    Set xFolderItem = CreateObject("Shell.Application").NameSpace(0).ParseName(xFileName)
    xFolderItem.InvokeVerbEx ("open")
    Set xFolderItem = Nothing
  End If
  Set xRegExp = Nothing
End Sub

在此代码中,它将创建一个以电子邮件主题命名并放置在路径中的新文本文件: C:\用户\公共\下载,您可以根据需要更改它。

文档提取网址 1

3。 点击 鑫安工具 > 參考資料 启用 参考 - 项目 1 对话框,勾选 Microsoft VBScript正则表达式5.5 复选框。 请点击 OK.

文档提取网址 1

文档提取网址 1

4。 按 F5 键或单击 运行 按钮运行代码,现在会弹出一个文本文件,其中所有 URL 都已提取。

文档提取网址 1

文档提取网址 1

备注:如果您是 Outlook 2010 和 Outlook 365 的用户,请同时在步骤 3 中勾选 Windows 脚本宿主对象模型复选框。然后单击确定。


VBA 从多封电子邮件中提取 URL 到 Excel 文件

 

如果您想从多个选定的电子邮件中提取 URL 到 Excel 文件,下面的 VBA 代码可以帮助您。

1. 选择您要提取 URL 的电子邮件,然后按 其他 + F11 启用键 Microsoft Visual Basic应用程序 窗口。

2。 点击 插页 > 模块 创建一个新的空白模块,然后将以下代码复制并粘贴到模块中。

VBA:将多封电子邮件中的所有 URL 提取到 Excel 文件中

'UpdatebyExtendoffice20220414
Dim xExcel As Excel.Application
Dim xExcelWb As Excel.Workbook
Dim xExcelWs As Excel.Worksheet

Sub ExportAllUrlsToExcelFromMultipleEmails()
  Dim xMail As MailItem
  Dim xSelection As Selection
  Dim xWordDoc As Word.Document
  Dim xHyperlink As Word.Hyperlink
  On Error Resume Next
  Set xSelection = Outlook.Application.ActiveExplorer.Selection
  If (xSelection Is Nothing) Then Exit Sub
  Set xExcel = CreateObject("Excel.Application")
  Set xExcelWb = xExcel.Workbooks.Add
  Set xExcelWs = xExcelWb.Sheets(1)
  xExcelWb.Activate
  With xExcelWs
    .Range("A1") = "Subject"
    .Range("B1") = "DisplayText"
    .Range("C1") = "Link"
  End With
  With xExcelWs.Range("A1", "C1").Font
    .Bold = True
    .Size = 12
  End With
  For Each xMail In xSelection
    Set xWordDoc = xMail.GetInspector.WordEditor
    If xWordDoc.Hyperlinks.Count > 0 Then
      For Each xHyperlink In xWordDoc.Hyperlinks
          Call ExportToExcelFile(xMail, xHyperlink)
      Next
    End If
  Next
  xExcelWs.Columns("A:C").AutoFit
  xExcel.Visible = True
End Sub

Sub ExportToExcelFile(curMail As MailItem, curHyperlink As Word.Hyperlink)
  Dim xRow As Integer
  xRow = xExcelWs.Range("A" & xExcelWs.Rows.Count).End(xlUp).Row + 1
  With xExcelWs
    .Cells(xRow, 1) = curMail.Subject
    .Cells(xRow, 2) = curHyperlink.TextToDisplay
    .Cells(xRow, 3) = curHyperlink.Address
  End With
End Sub

在此代码中,它提取所有超链接以及相应的显示文本和电子邮件主题。

文档提取网址 1

3。 点击 鑫安工具 > 參考資料 启用 参考 - 项目 1 对话框,打勾 Microsoft Excel 16.0 对象库 Microsoft Word 16.0对象库 复选框。 点击 OK.

文档提取网址 1

文档提取网址 1

4. 然后将光标放在 VBA 代码内,按 F5 键或单击 运行 按钮运行代码,现在会弹出一个工作簿,其中所有 URL 都已提取,然后您可以将其保存到文件夹中。

文档提取网址 1

备注:以上所有 VBA 都提取所有类型的超链接。


Kutools for Outlook-为Outlook带来100个高级功能,并使工作更加轻松!

  • 自动CC / BCC 根据规则发送电子邮件; 自动转发 自定义多封电子邮件; 自动回复 没有交换服务器,还有更多自动功能...
  • BCC警告 -当您尝试全部答复时显示消息 如果您的邮件地址在“密件抄送”列表中; 缺少附件时提醒,还有更多提醒功能...
  • 在邮件对话中回复(全部)带有所有附件; 回复许多电子邮件 很快; 自动添加问候语 回复时将日期添加到主题中...
  • 附件工具:管理所有邮件中的所有附件, 自动分离, 全部压缩,全部重命名,全部保存...快速报告, 计算选定的邮件...
  • 强大的垃圾邮件 习俗 删除重复的邮件和联系人... 使您能够在Outlook中做得更聪明,更快和更好。
拍摄kutools前景kutools选项卡1180x121
拍摄kutools前景kutools加标签1180x121
 
按评论排序
注释 (0)
还没有评分。 成为第一位评论!
这里还没有评论
留下你的意见
以访客身份发帖
×
评价此帖子:
0  产品特性
建议地点