Outlook：如何從一封電子郵件中提取所有 URL

作者：孫最後修改時間：2022-04-29

如果一封電子郵件包含數百個需要提取到文本文件的 URL，那麼逐個複制和粘貼將是一項繁瑣的工作。本教程介紹了可以快速從電子郵件中提取所有 URL 的 VBA。

VBA 從一封電子郵件中提取 URL 到文本文件

VBA 從多封電子郵件中提取 URL 到 Excel 文件

Office 標籤 - 在 Microsoft Office 中啟用選項卡式編輯和瀏覽，讓工作變得輕而易舉

閱讀更多...下載...

Kutools for Outlook - 透過 100 多個進階功能增強 Outlook，實現卓越效率

自動發送電子郵件自動CC / BCC, 自動前進按規則；傳送自動回复（不在辦公室）無需交換伺服器...
取得類似提醒 BCC警告當您在密件副本清單中回覆所有內容時，以及缺少附件時提醒對於忘記的附件...
提高電子郵件效率回覆（全部）並附上附件, 自動添加問候語或日期和時間到簽名或主題中, 回覆多封電子郵件...
簡化電子郵件發送撤回電子郵件, 附件工具（壓縮全部、自動儲存全部...）、刪除重複項和快速報告...

使用這些進階功能增強您的 Outlook 2021 - 2010 或 Outlook 365。享受全面的 60 天免費試用並提升您的電子郵件體驗！

閱讀更多...下載...

VBA 從一封電子郵件中提取 URL 到文本文件

1. 選擇您要提取 URL 的電子郵件，然後按其他 + F11 啟用鍵 Microsoft Visual Basic for Applications 窗口。

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

4。按 F5 鍵或單擊跑按鈕運行代碼，現在會彈出一個文本文件，其中所有 URL 都已提取。

文檔提取網址 1

備註：如果您是 Outlook 2010 和 Outlook 365 的用戶，請同時在步驟 3 中勾選 Windows 腳本宿主對像模型複選框。然後單擊確定。

VBA 從多封電子郵件中提取 URL 到 Excel 文件

如果您想從多個選定的電子郵件中提取 URL 到 Excel 文件，下面的 VBA 代碼可以幫助您。

1. 選擇您要提取 URL 的電子郵件，然後按其他 + F11 啟用鍵 Microsoft Visual Basic for Applications 窗口。

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