Outlook: Как извлечь все URL-адреса из одного письма

Author Sun Last modified 2025-08-26

Если письмо содержит сотни URL-адресов, которые нужно извлечь в текстовый файл, копирование и вставка их по одному станет утомительной задачей. В этом руководстве представлены VBA-скрипты, которые могут быстро извлечь все URL-адреса из письма.

VBA для извлечения URL-адресов из одного письма в текстовый файл

VBA для извлечения URL-адресов из нескольких писем в файл Excel

Office Tab - Включите редактирование и просмотр с вкладками в Microsoft Office, делая работу проще

Читать функции Office Tab Скачать Office Tab

Разблокируйте Kutools для Outlook прямо сейчас и получите доступ к более чем 100 функциям без ограничений навсегда

Повысьте продуктивность обработки электронной почты с помощью технологии ИИ, позволяя быстро отвечать на письма, создавать новые, переводить сообщения и многое другое.
Автоматизируйте отправку писем с помощью Авто Копии/Скрытой копии, Автоматического перенаправления по правилам; отправляйте Автоответчик (Вне офиса) без необходимости использования сервера Exchange...
Получайте напоминания, такие как Предупреждение при ответе на электронное письмо, в котором я указан в поле BCC, а также напоминания о пропущенных вложениях...
Улучшите эффективность работы с электронной почтой с помощью Ответа (всем) с вложениями, автоматического добавления приветствия или даты и времени в подпись или тему, ответа на несколько писем...
Оптимизируйте работу с электронной почтой с помощью функций Отзыва писем, Инструментов вложений (Сжать все, Автосохранение всех...), Удаление дубликатов и Быстрый отчет...

Увеличьте возможности Outlook 2024 - 2010 или Outlook 365 с этими расширенными функциями. Наслаждайтесь более чем 100 мощными функциями и улучшите свой опыт работы с электронной почтой!

Читать все функции Kutools для Outlook Скачать сейчас

VBA для извлечения URL-адресов из одного письма в текстовый файл

1. Выберите письмо, из которого вы хотите извлечь URL-адреса, и нажмите клавиши Alt + 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:\Users\Public\Downloads. Вы можете изменить его по своему усмотрению.

steps on extracting all URLs from one email

3. Нажмите Инструменты > Ссылки, чтобы открыть диалоговое окно Ссылки – Проект 1, установите флажок Microsoft VBScript Regular Expressions 5.5. Нажмите OK.

4. Нажмите клавишу F5 или кнопку Выполнить , чтобы запустить код. Теперь появится текстовый файл, и все URL-адреса будут извлечены в него.

Примечание: если вы пользователь Outlook 2010 и Outlook 365, также установите флажок Windows Script Host Object Model на шаге 3. Затем нажмите OK.

VBA для извлечения URL-адресов из нескольких писем в файл Excel

Если вы хотите извлечь URL-адреса из нескольких выбранных писем в файл Excel, следующий код VBA может помочь вам.

1. Выберите письмо, из которого вы хотите извлечь URL-адреса, и нажмите клавиши Alt + F11 , чтобы открыть окно Microsoft Visual Basic for Applications.

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 Object Library и Microsoft Word 16.0 Object Library. Нажмите OK.

4. Затем поместите курсор внутри кода VBA, нажмите клавишу F5 или кнопку Выполнить, чтобы запустить код. Теперь появится книга, и все URL-адреса будут извлечены в неё, после чего вы сможете сохранить её в папке.