Přejít k hlavnímu obsahu

Outlook: Jak extrahovat všechny adresy URL z jednoho e-mailu

Pokud e-mail obsahuje stovky adres URL, které je třeba extrahovat do textového souboru, bude jejich kopírování a vkládání jednu po druhé zdlouhavá práce. Tento výukový program představuje VBA, které dokážou rychle extrahovat všechny adresy URL z e-mailu.

VBA pro extrahování adres URL z jednoho e-mailu do textového souboru

VBA pro extrahování adres URL z více e-mailů do souboru aplikace Excel

Karta Office – Povolte úpravy a procházení na kartách v Microsoft Office, díky čemuž bude práce hračkou
Kutools pro Outlook – Vylepšete Outlook se 100+ pokročilými funkcemi pro vynikající efektivitu
Vylepšete svůj Outlook 2021–2010 nebo Outlook 365 pomocí těchto pokročilých funkcí. Užijte si komplexní 60denní bezplatnou zkušební verzi a vylepšete svůj e-mailový zážitek!

VBA pro extrahování adres URL z jednoho e-mailu do textového souboru

 

1. Vyberte e-mail, ze kterého chcete extrahovat adresy URL, a stiskněte Další + F11 klíče k povolení Microsoft Visual Basic pro aplikace okno.

2. cvaknutí Vložit > Modul vytvořte nový prázdný modul, poté zkopírujte a vložte níže uvedený kód do modulu.

VBA: extrahujte všechny adresy URL z jednoho e-mailu do textového souboru.

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

V tomto kódu vytvoří nový textový soubor, který bude pojmenován s předmětem e-mailu a umístěn v cestě: C:\Users\Veřejné\Stahování, můžete jej změnit, jak potřebujete.

URL extraktu z dokumentu 1

3. cvaknutí Tools > Reference umožnit Reference – Projekt 1 dialogu, zaškrtněte Pravidelné výrazy Microsoft VBScript 5.5 zaškrtávací políčko. Klepněte na OK.

URL extraktu z dokumentu 1

URL extraktu z dokumentu 1

4. lis F5 klíč nebo klik Běh tlačítko pro spuštění kódu, nyní se objeví textový soubor a všechny adresy URL jsou v něm extrahovány.

URL extraktu z dokumentu 1

URL extraktu z dokumentu 1

Poznámka: Pokud používáte Outlook 2010 a Outlook 365, zaškrtněte také políčko Windows Script Host Object Model v kroku 3. Poté klikněte na OK.


VBA pro extrahování adres URL z více e-mailů do souboru aplikace Excel

 

Pokud chcete extrahovat adresy URL z více vybraných e-mailů do souboru aplikace Excel, níže uvedený kód VBA vám může pomoci.

1. Vyberte e-mail, ze kterého chcete extrahovat adresy URL, a stiskněte Další + F11 klíče k povolení Microsoft Visual Basic pro aplikace okno.

2. cvaknutí Vložit > Modul vytvořte nový prázdný modul, poté zkopírujte a vložte níže uvedený kód do modulu.

VBA: extrahujte všechny adresy URL z více e-mailů do souboru aplikace 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

V tomto kódu extrahuje všechny hypertextové odkazy a odpovídající zobrazované texty a předměty e-mailu.

URL extraktu z dokumentu 1

3. cvaknutí Tools > Reference umožnit Reference – Projekt 1 dialog, zaškrtněte Objektová knihovna Microsoft Excel 16.0 a Knihovna objektů Microsoft Word 16.0 zaškrtávací políčka. Klikněte OK.

URL extraktu z dokumentu 1

URL extraktu z dokumentu 1

4. Poté umístěte kurzor do kódu VBA a stiskněte F5 klíč nebo klik Běh tlačítko pro spuštění kódu, nyní se objeví sešit a všechny adresy URL v něm byly extrahovány, pak jej můžete uložit do složky.

URL extraktu z dokumentu 1

Poznámka: všechny výše uvedené VBA extrahují všechny typy hypertextových odkazů.


Nejlepší nástroje pro produktivitu v kanceláři

Kutools pro aplikaci Outlook - Více než 100 výkonných funkcí, které doplní váš Outlook

🤖 AI Mail Assistant: Okamžité profesionální e-maily s magií umělé inteligence – jedním kliknutím získáte geniální odpovědi, perfektní tón, vícejazyčné ovládání. Transformujte e-maily bez námahy! ...

???? Automatizace e-mailu: Mimo kancelář (k dispozici pro POP a IMAP)  /  Naplánujte odesílání e-mailů  /  Automatická kopie/skrytá kopie podle pravidel při odesílání e-mailu  /  Automatické přeposílání (pokročilá pravidla)   /  Automatické přidání pozdravu   /  Automaticky rozdělte e-maily pro více příjemců na jednotlivé zprávy ...

📨 Email management: Snadné vyvolání e-mailů  /  Blokujte podvodné e-maily podle předmětů a dalších  /  Odstranit duplicitní e-maily  /  pokročilé vyhledávání  /  Konsolidovat složky ...

📁 Přílohy ProDávkové uložení  /  Dávkové odpojení  /  Dávková komprese  /  Automaticky uložit   /  Automatické odpojení  /  Automatické komprimování ...

???? Rozhraní Magic: 😊 Více pěkných a skvělých emotikonů   /  Zvyšte produktivitu své aplikace Outlook pomocí zobrazení s kartami  /  Minimalizujte aplikaci Outlook namísto zavírání ...

???? Zázraky na jedno kliknutí: Odpovědět všem s příchozími přílohami  /   E-maily proti phishingu  /  🕘Zobrazit časové pásmo odesílatele ...

👩🏼‍🤝‍👩🏻 Kontakty a kalendář: Dávkové přidání kontaktů z vybraných e-mailů  /  Rozdělit skupinu kontaktů na jednotlivé skupiny  /  Odeberte připomenutí narozenin ...

Přes 100 Vlastnosti Očekávejte svůj průzkum! Kliknutím sem zobrazíte další informace.

Více       Stažení zdarma      Nákup
 

 

Comments (0)
No ratings yet. Be the first to rate!
There are no comments posted here yet
Please leave your comments in English
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations