Outlook: Hur man extraherar alla webbadresser från ett e-postmeddelande

Om ett e-postmeddelande innehåller hundratals webbadresser som behöver extraheras till en textfil, kommer det att vara ett tråkigt jobb att kopiera och klistra in dem en efter en. Denna handledning introducerar VBA:er som snabbt kan extrahera alla webbadresser från ett e-postmeddelande.

VBA för att extrahera webbadresser från ett e-postmeddelande till en textfil

VBA för att extrahera webbadresser från flera e-postmeddelanden till en Excel-fil

VBA för att extrahera webbadresser från ett e-postmeddelande till en textfil

1. Välj ett e-postmeddelande som du vill extrahera URL:erna och tryck på andra + F11 för att aktivera Microsoft Visual Basic för applikationer fönster.

2. klick Insert > Modulerna för att skapa en ny tom modul, kopiera och klistra sedan in nedanstående kod i modulen.

VBA: extrahera alla webbadresser från ett e-postmeddelande till en textfil.

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

I den här koden kommer den att skapa en ny textfil som namnges med e-postämnet och placeras i sökvägen: C:\Users\Public\Nedladdningar, kan du ändra det efter behov.

3. klick verktyg > Referensprojekt att möjliggöra Referenser – Projekt 1 dialogrutan, markera Microsoft VBScript Regular Expressions 5.5 kryssruta. Klick OK.

4. Tryck F5 eller klicka Körning knappen för att köra koden, nu dyker en textfil ut och alla webbadresser har extraherats i den.

Anmärkningar: om du är användare av Outlook 2010 och Outlook 365, markera även kryssrutan Windows Script Host Object Model i steg 3. Klicka sedan på OK.

VBA för att extrahera webbadresser från flera e-postmeddelanden till en Excel-fil

Om du vill extrahera webbadresser från flera utvalda e-postmeddelanden till en Excel-fil kan nedanstående VBA-kod hjälpa dig.

1. Välj ett e-postmeddelande som du vill extrahera URL:erna och tryck på andra + F11 för att aktivera Microsoft Visual Basic för applikationer fönster.

2. klick Insert > Modulerna för att skapa en ny tom modul, kopiera och klistra sedan in nedanstående kod i modulen.

VBA: extrahera alla webbadresser från flera e-postmeddelanden till en Excel-fil

'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

I den här koden extraherar den alla hyperlänkar och motsvarande visningstexter och e-postämnen.

3. klick verktyg > Referensprojekt att möjliggöra Referenser – Projekt 1 dialog, bocka Microsoft Excel 16.0 Objektbibliotek och Microsoft Word 16.0-objektbibliotek kryssrutor. Klick OK.

4. Placera sedan markören inom VBA-koden, tryck F5 eller klicka Körning knappen för att köra koden, nu dyker en arbetsbok ut och alla webbadresser har extraherats i den, sedan kan du spara den i en mapp.

Anmärkningar: alla ovanstående VBA extraherar alla typer av hyperlänkar.

---

Bästa kontorsproduktivitetsverktyg

Nyheter: Kutools för Outlook lanserar gratisversion!

Upplev den helt nya Kutools för Outlook GRATIS version med 70+ otroliga funktioner, din att använda FÖR EVIGT! Klicka för att ladda ner nu!

🤖 Kutools AI : Använder avancerad AI-teknik för att hantera e-postmeddelanden utan ansträngning, inklusive att svara, sammanfatta, optimera, utöka, översätta och skriva e-postmeddelanden.

📧 Email Automation: Autosvar (tillgängligt för POP och IMAP)  /  Schemalägg Skicka e-post  /  Auto CC/BCC enligt regler när du skickar e-post  /  Automatisk vidarebefordran (avancerade regler)   /  Lägg automatiskt till hälsning   /  Dela automatiskt e-postmeddelanden med flera mottagare i individuella meddelanden ...

📨 Email Management: Återkalla e-postmeddelanden  /  Blockera bluff-e-postmeddelanden av ämnen och andra  /  Ta bort duplicerade e-postmeddelanden  /  Avancerad Sökning  /  Konsolidera mappar ...

📁 Bilagor Pro: Batch Spara  /  Batch lossa  /  Batchkomprimera  /  Automatisk sparning   /  Auto Lossa  /  Automatisk komprimering ...

🌟 Gränssnittsmagi: 😊 Fler vackra och coola emojis   /  Påminn dig när viktiga mejl kommer  /  Minimera Outlook istället för att stänga ...

👍 Underverk med ett klick: Svara alla med bilagor  /   E-postmeddelanden mot nätfiske  /  🕘Visa avsändarens tidszon ...

👩🏼‍🤝‍👩🏻 Kontakter och kalender: Lägg till kontakter i grupp från valda e-postmeddelanden  /  Dela upp en kontaktgrupp till individuella grupper  /  Ta bort påminnelser om födelsedag ...

Lås upp Kutools för Outlook omedelbart med ett enda klick. Vänta inte, ladda ner nu och öka din effektivitet!

Funktionslista över Kutools för Outlook      Ladda ner gratis version      Uppgradera till Professional