Outlook：如何從一封郵件中提取所有網址

Author Sun Last modified 2025-08-23

如果一封郵件包含數百個需要提取到文本文件的網址，逐一手動複製和粘貼將會非常繁瑣。本教程介紹了可以快速從郵件中提取所有網址的VBA程式碼。

用於將網址從一封郵件提取到文本文件的VBA程式碼

用於將網址從多封郵件提取到Excel文件的VBA程式碼

Office Tab - 在 Microsoft Office 中啟用分頁編輯和瀏覽功能，讓工作變得輕鬆愉快

閱讀 Office Tab 的功能下載 Office Tab

立即解鎖 Kutools for Outlook，享受超過 100 種功能的無限存取權限

透過 AI 技術提升您的電子郵件生產力，讓您快速回覆郵件、起草新郵件、翻譯郵件等，更有效率地進行操作。
透過規則自動化電子郵件處理，例如自動抄送密送、自動轉發；在不需要交換伺服器的情況下發送自動回覆（外出）...
當您處於密件抄送列表時，回覆所有人會收到類似密件抄送提示的提醒，並在忘記附件時獲得遺漏附件提醒...
透過帶有附件的回覆（全部）、自動新增問候語或日期時間至簽名或主題、回覆多封郵件等功能提高郵件效率...
透過撤回郵件、附件工具（壓縮全部、自動保存全部...）、刪除重複郵件以及快速報告等功能簡化郵件處理流程...

透過這些高級功能增強您的 Outlook 2024 - 2010 或 Outlook 365。享受 100 多種強大功能，提升您的郵件體驗！

閱讀 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. 點擊工具 > 參考以啟用 參考 – 專案 1 對話框，勾選 Microsoft VBScript Regular Expressions 5.5 複選框，然後點擊確定。

4. 按下 F5 鍵或點擊執行按鈕來運行代碼，現在會彈出一個文本文件，並且所有網址都已提取到其中。

注意：如果您是 Outlook 2010 和 Outlook 365 的用戶，請在步驟 3 中也勾選 Windows Script Host Object Model 複選框，然後點擊確定。

用於將網址從多封郵件提取到Excel文件的VBA程式碼

如果您想從多封選中的郵件中提取網址到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. 點擊工具 > 參考以啟用 參考 – 專案 1 對話框，勾選 Microsoft Excel 16.0 Object Library 和 Microsoft Word 16.0 Object Library 複選框，然後點擊確定。

4. 然後將光標放在VBA代碼內，按下 F5 鍵或點擊執行按鈕來運行代碼，現在會彈出一個工作簿，並且所有網址都已提取到其中，然後您可以將其保存到文件夾中。

注意：以上所有的VBA程式碼都可以提取各種類型的超鏈接。

最佳辦公室生產力工具

最新消息：Kutools for Outlook 推出免費版本！

體驗全新 Kutools for Outlook，超過100項精彩功能！立即下載！

🤖 Kutools AI ：採用先進的AI技術輕鬆處理郵件，包括答覆、摘要、優化、擴充、翻譯及撰寫郵件。

📧 郵件自動化：自動回覆（支援POP及IMAP） / 排程發送郵件 / 發送郵件時根據規則自動抄送密送 / 自動轉發（高級規則） / 自動添加問候語 / 自動分割多收件人郵件為個別郵件 ...

📨 郵件管理：撤回郵件 / 根據主題等方式阻止詐騙郵件 / 刪除重複郵件 / 高級搜索 / 整合文件夾 ...

📁 附件專業工具：批量保存 / 批量拆離 / 批量壓縮 / 自動保存 / 自動拆離 / 自動壓縮 ...

👍 一鍵便利：帶附件全部答復 / 防詐騙郵件 / 🕘顯示發件人時區 ...

👩🏼‍🤝‍👩🏻 聯絡人與日曆：從選中郵件批量添加聯絡人 / 分割聯絡人組為個別組 / 移除生日提醒 ...

以您偏好的語言使用 Kutools，支援英語、西班牙語、德語、法語、中文及超過40種其他語言！

只需點擊一次，即可立即解鎖 Kutools for Outlook。別等了，現在下載提升您的工作效率！

Kutools for Outlook 功能清單立即下載前往購買

🚀 一鍵下載 — 獲取全部 Office 插件

強力推薦：Kutools for Office（5合1）

一鍵下載五個安裝程式，包括 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

套件介紹 ⬇下載套件 💳 購買套件