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

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

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

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

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

Больше информации...Скачать ...

Kutools for Outlook - улучшите Outlook с помощью более 100 расширенных функций для повышения эффективности

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

Улучшите свой Outlook 2021–2010 или Outlook 365 с помощью этих расширенных функций. Наслаждайтесь полной 60-дневной бесплатной пробной версией и улучшите качество своей электронной почты!

Больше информации...Скачать ...

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:\Пользователи\Общие\Загрузки, вы можете изменить его по мере необходимости.

URL извлечения документа 1

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

URL извлечения документа 1

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

URL извлечения документа 1

Внимание: если вы являетесь пользователем Outlook 2010 и Outlook 365, также установите флажок «Объектная модель хоста сценария Windows» на шаге 3. Затем нажмите «ОК».

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

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

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

В этом коде он извлекает все гиперссылки и соответствующие отображаемые тексты, а также темы электронных писем.

URL извлечения документа 1

3. Нажмите Инструменты > Рекомендации включить Ссылки – Проект 1 диалог, галочка Библиотека объектов Microsoft Excel 16.0 и Библиотека объектов Microsoft Word 16.0 флажки. Нажмите OK.

URL извлечения документа 1

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

URL извлечения документа 1