Outlook：如何从一封邮件中提取所有网址

Author: Sun Last Modified: 2025-07-31

如果一封邮件包含需要提取到文本文件中的数百个网址，逐一手动复制粘贴将是一项繁琐的任务。本教程介绍可以快速从邮件中提取所有网址的VBA代码。

使用VBA将网址从一封邮件提取到文本文件

使用VBA将网址从多封邮件提取到Excel文件

Office Tab - 在 Microsoft Office 中启用标签页编辑和浏览，让工作变得轻松愉快。

阅读 Office Tab 的功能下载 Office Tab

立即解锁 Kutools for Outlook 的免费版本，永久享受超过 70 项功能的无限访问权限。

通过 AI 技术提升您的邮件处理效率，帮助您快速回复邮件、撰写新邮件、翻译消息等，更加高效地完成任务。
通过规则实现自动抄送密送、自动转发；无需 Exchange 服务器即可发送自动答复（外出）...
当您在密件抄送列表中回复所有人时，获得诸如答复的邮件为 BCC 时提醒等提示，并在忘记附件时收到提醒...
通过带附件回复（全部）、自动添加问候语或日期时间至签名或主题、批量回复邮件等功能提高邮件效率...
通过撤回邮件、附件工具（压缩所有附件、自动保存所有附件...）、删除重复邮件以及快速报告等功能简化邮件操作...

通过这些高级功能增强您的 Outlook 2024 - 2010 或 Outlook 365。享受 70 多种强大功能，提升您的邮件体验！

阅读 Kutools for Outlook 的所有功能下载免费版本

使用VBA将网址从一封邮件提取到文本文件

1. 选择您要提取网址的邮件，并按 Alt + F11 键打开 Microsoft Visual Basic for Applications 窗口。

2. 单击插入 > 模块创建一个新的空白模块，然后将以下代码复制并粘贴到该模块中。

VBA：从一封邮件中提取所有网址到文本文件。

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:\Users\Public\Downloads 中，您可以根据需要进行更改。

steps on extracting all URLs from one email

3. 单击工具 > 引用打开 引用 – Project 1 对话框，勾选 Microsoft VBScript Regular Expressions 5.5 复选框，然后单击确定。

4. 按 F5 键或单击运行按钮运行代码，此时会弹出一个文本文件，其中已提取了所有网址。

注意：如果您是 Outlook 2010 和 Outlook 365 的用户，请在步骤 3 中也勾选 Windows Script Host Object Model 复选框，然后单击确定。

使用VBA将网址从多封邮件提取到Excel文件

如果您想从多个选定的邮件中提取网址到 Excel 文件，以下 VBA 代码可以帮助您完成。

1. 选择您要提取网址的邮件，并按 Alt + F11 键打开 Microsoft Visual Basic for Applications 窗口。

2. 单击插入 > 模块创建一个新的空白模块，然后将以下代码复制并粘贴到该模块中。

VBA：从多封邮件中提取所有网址到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

此代码提取所有超链接及其对应的显示文本和邮件主题。