Outlook:如何从一封邮件中提取所有网址
如果一封邮件包含需要提取到文本文件中的数百个网址,逐一手动复制粘贴将是一项繁琐的任务。本教程介绍可以快速从邮件中提取所有网址的VBA代码。
- 通过人工智能技术提升您的邮件处理效率,让您能够快速回复邮件、撰写新邮件、翻译消息等,更加高效地完成工作。
- 通过规则实现自动抄送密送、自动转发;无需 Exchange 服务器即可发送自动答复(外出)……
- 当您在密件抄送列表中时,可获得如答复的邮件为 BCC 时提醒之类的提示,并且在忘记添加附件时获得提醒……
- 借助带附件回复(全部)、自动在签名或主题中添加问候语或日期时间、批量回复邮件等功能提高邮件处理效率……
- 通过撤回邮件、附件工具(压缩所有附件、自动保存所有附件……)、删除重复邮件和快速报告等功能简化邮件操作……
使用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 中,您可以根据需要进行更改。

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
此代码提取所有超链接及其对应的显示文本和邮件主题。

3. 单击 工具 > 引用 打开 引用 – Project 1 对话框,勾选 Microsoft Excel 16.0 Object Library 和 Microsoft Word 16.0 Object Library 复选框,然后单击 确定。


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

注意:以上所有的VBA代码均提取所有类型的超链接。
最佳 Office 办公效率工具
最新消息:Kutools for Outlook 推出免费版!
体验全新 Kutools for Outlook,超过100 种强大功能!立即点击下载!
🤖 Kutools AI :采用先进的 AI 技术,轻松处理邮件,包括答复、总结、优化、扩展、翻译和撰写邮件。
📧 邮箱自动化:自动答复(支持 POP 和 IMAP) /计划发送邮件 /发送邮件时按规则自动抄送密送 / 自动转发(高级规则) / 自动添加问候语 / 自动将多收件人的邮件分割为单独邮件 ...
📨 邮件管理:撤回邮件 / 按主题及其他条件阻止欺诈邮件 / 删除重复邮件 / 高级搜索 / 整合文件夹 ...
📁 附件增强:批量保存 / 批量拆离 / 批量压缩 / 自动保存 / 自动拆离 / 自动压缩 ...
🌟 界面魔法:😊更多美观酷炫的表情 /重要邮件到达时提醒 / 最小化 Outlook 而非关闭 ...
👍 一键高效操作:带附件全部答复 / 防钓鱼邮件 / 🕘显示发件人时区 ...
👩🏼🤝👩🏻 联系人与日历:批量添加选中邮件中的联系人 / 分割联系人组为单独的组 / 移除生日提醒 ...
可根据您偏好选择 Kutools 使用语言——支持英语、西班牙语、德语、法语、中文及40 多种其他语言!
只需点击一下即可立即激活 Kutools for Outlook。无需等待,立即下载,提升工作效率!


🚀 一键下载——获取所有 Office 插件
强烈推荐:Kutools for Office(五合一)
一键下载五个安装包:Kutools for Excel、Outlook、Word、PowerPoint以及 Office Tab Pro。 立即点击下载!
- ✅ 一键便利操作:一次下载全部五个安装包。
- 🚀 随时满足 Office任务需求:需要哪个插件随时安装即可。
- 🧰 包含:Kutools for Excel / Kutools for Outlook / Kutools for Word / Office Tab Pro / Kutools for PowerPoint