Outlook : Comment extraire toutes les URL d'un seul e-mail

Si un e-mail contient des centaines d'URL à extraire dans un fichier texte, les copier et les coller une par une sera un travail fastidieux. Ce didacticiel présente les VBA capables d'extraire rapidement toutes les URL d'un e-mail.

VBA pour extraire les URL d'un e-mail vers un fichier texte

VBA pour extraire les URL de plusieurs e-mails vers un fichier Excel

VBA pour extraire les URL d'un e-mail vers un fichier texte

1. Sélectionnez un e-mail dont vous souhaitez extraire les URL, puis appuyez sur autre + F11 clés pour activer Microsoft Visual Basic pour applications fenêtre.

2. Cliquez insérer > Module pour créer un nouveau module vierge, puis copiez et collez le code ci-dessous dans le module.

VBA : extrayez toutes les URL d'un e-mail vers un fichier texte.

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

Dans ce code, il créera un nouveau fichier texte nommé avec le sujet de l'e-mail et placé dans le chemin : C:\Utilisateurs\Public\Téléchargements, vous pouvez le modifier selon vos besoins.

3. Cliquez Outils > Références autoriser Références – Projet 1 boîte de dialogue, cochez la Expressions régulières Microsoft VBScript 5.5 case à cocher Cliquez sur OK.

4. presse F5 touche ou cliquez course bouton pour exécuter le code, maintenant un fichier texte apparaît et toutes les URL y ont été extraites.

Notes: si vous utilisez Outlook 2010 et Outlook 365, veuillez également cocher la case Modèle d'objet hôte de script Windows à l'étape 3. Cliquez ensuite sur OK.

VBA pour extraire les URL de plusieurs e-mails vers un fichier Excel

Si vous souhaitez extraire les URL de plusieurs e-mails sélectionnés dans un fichier Excel, le code VBA ci-dessous peut vous aider.

1. Sélectionnez un e-mail dont vous souhaitez extraire les URL, puis appuyez sur autre + F11 clés pour activer Microsoft Visual Basic pour applications fenêtre.

2. Cliquez insérer > Module pour créer un nouveau module vierge, puis copiez et collez le code ci-dessous dans le module.

VBA : extrayez toutes les URL de plusieurs e-mails vers un fichier 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

Dans ce code, il extrait tous les hyperliens et les textes d'affichage correspondants et les sujets des e-mails.

3. Cliquez Outils > Références autoriser Références – Projet 1 boîte de dialogue, cocher Bibliothèque d'objets Microsoft Excel 16.0 et des tours Bibliothèque d'objets Microsoft Word 16.0 cases à cocher. Cliquez sur OK.

4. Placez ensuite le curseur dans le code VBA, appuyez sur F5 touche ou cliquez course bouton pour exécuter le code, maintenant un classeur apparaît et toutes les URL y ont été extraites, vous pouvez alors l'enregistrer dans un dossier.

Notes: tous les VBA ci-dessus extraient tous les types d'hyperliens.

Kutools for Outlook - Apporte 100 fonctionnalités avancées à Outlook et simplifie grandement le travail!

• CC / BCC automatique par des règles lors de l'envoi d'e-mails; Transfert automatique Emails multiples par coutume; Réponse automatique sans serveur d'échange, et plus de fonctionnalités automatiques ...
• Avertissement BCC - afficher le message lorsque vous essayez de répondre à tous si votre adresse e-mail est dans la liste BCC; Rappeler en cas de pièces jointes manquantes, et plus de fonctionnalités de rappel ...
• Répondre (à tous) avec toutes les pièces jointes dans la conversation par courrier électronique; Répondre à de nombreux e-mails en secondes; Ajouter un message d'accueil automatique quand répondre; Ajouter la date au sujet ...
• Outils de pièces jointes: gérer toutes les pièces jointes dans tous les courriers, Détachement automatique, Compresser tout, Tout renommer, Tout enregistrer ... Rapport rapide, Compter les courriers sélectionnésplus
• Courriels indésirables puissants par coutume; Supprimer les messages et contacts en doubleplus Vous permettre de faire plus intelligemment, plus rapidement et mieux dans Outlook.

Lire la suite... Télécharger maintenant...