Outlook:如何从一封电子邮件中提取所有 URL
如果一封电子邮件包含数百个需要提取到文本文件的 URL,那么逐个复制和粘贴将是一项繁琐的工作。 本教程介绍了可以快速从电子邮件中提取所有 URL 的 VBA。
- 自动发送电子邮件 自动CC / BCC, 自动转发 按规则; 发送 自动回复 (不在办公室)无需交换服务器...
- 获取类似提醒 BCC警告 当您在密件抄送列表中回复所有内容时,以及 缺少附件时提醒 对于忘记的附件...
- 提高电子邮件效率 回复(全部)并附上附件, 自动添加问候语或日期和时间到签名或主题中, 回复多封电子邮件...
- 简化电子邮件发送 撤回电子邮件, 附件工具 (压缩全部、自动保存全部...)、 删除重复及 快速报告...
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:\用户\公共\下载,您可以根据需要更改它。
3。 点击 工具 > 参考资料 启用 参考 - 项目 1 对话框,勾选 Microsoft VBScript正则表达式5.5 复选框。 请点击 OK.
4。 按 F5 键或单击 运行 按钮运行代码,现在会弹出一个文本文件,其中所有 URL 都已提取。
备注:如果您是 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
在此代码中,它提取所有超链接以及相应的显示文本和电子邮件主题。
3。 点击 工具 > 参考资料 启用 参考 - 项目 1 对话框,打勾 Microsoft Excel 16.0 对象库 和 Microsoft Word 16.0对象库 复选框。 点击 OK.
4. 然后将光标放在 VBA 代码内,按 F5 键或单击 运行 按钮运行代码,现在会弹出一个工作簿,其中所有 URL 都已提取,然后您可以将其保存到文件夹中。
备注:以上所有 VBA 都提取所有类型的超链接。
最佳办公生产力工具
Kutools for Outlook - 超过 100 种强大功能可增强您的 Outlook
🤖 人工智能邮件助手: 具有人工智能魔力的即时专业电子邮件——一键天才回复、完美语气、多语言掌握。轻松改变电子邮件! ...
📧 电子邮件自动化: 外出(适用于 POP 和 IMAP) / 安排发送电子邮件 / 发送电子邮件时按规则自动抄送/密件抄送 / 自动转发(高级规则) / 自动添加问候语 / 自动将多收件人电子邮件拆分为单独的消息 ...
📨 电子邮件管理: 轻松回忆电子邮件 / 按主题和其他人阻止诈骗电子邮件 / 删除重复的电子邮件 / 高级搜索 / 合并文件夹 ...
📁 附件专业版: 批量保存 / 批量分离 / 批量压缩 / 自动保存 / 自动分离 / 自动压缩 ...
🌟 界面魔法: 😊更多又漂亮又酷的表情符号 / 使用选项卡式视图提高 Outlook 工作效率 / 最小化 Outlook 而不是关闭 ...
👍 一键奇迹: 使用传入附件回复全部 / 反网络钓鱼电子邮件 / 🕘显示发件人的时区 ...
👩🏼🤝👩🏻 通讯录和日历: 从选定的电子邮件中批量添加联系人 / 将联系人组拆分为各个组 / 删除生日提醒 ...
超过 100特点 等待您的探索! 单击此处了解更多。