Outlook: Cara mengekstrak semua URL dari satu email

Jika email berisi ratusan URL yang perlu diekstraksi ke file teks, menyalin dan menempelkannya satu per satu akan menjadi pekerjaan yang membosankan. Tutorial ini memperkenalkan VBA yang dapat dengan cepat mengekstrak semua URL dari email.

VBA untuk mengekstrak URL dari satu email ke file teks

VBA untuk mengekstrak URL dari beberapa email ke file Excel

VBA untuk mengekstrak URL dari satu email ke file teks

1. Pilih email yang ingin Anda ekstrak URL-nya, dan tekan lain + F11 kunci untuk mengaktifkan Microsoft Visual Basic untuk Aplikasi jendela.

2. klik Menyisipkan > Modul untuk membuat modul kosong baru, lalu salin dan tempel kode di bawah ini ke modul.

VBA: ekstrak semua URL dari satu email ke file teks.

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

Dalam kode ini, itu akan membuat file teks baru yang diberi nama dengan subjek email dan ditempatkan di jalur: C:\Pengguna\Publik\Unduhan, Anda dapat mengubahnya sesuai kebutuhan.

3. klik Tools > Referensi untuk mengaktifkan Referensi – Proyek 1 dialog, centang Ekspresi Reguler Microsoft VBScript 5.5 kotak centang. Klik OK.

4. tekan F5 kunci atau klik Run tombol untuk menjalankan kode, sekarang file teks muncul dan semua URL telah diekstraksi di dalamnya.

Note: jika Anda pengguna Outlook 2010 dan Outlook 365, centang juga kotak Windows Script Host Object Model di Langkah 3. Kemudian klik OK.

VBA untuk mengekstrak URL dari beberapa email ke file Excel

Jika Anda ingin mengekstrak URL dari beberapa email yang dipilih ke file Excel, kode VBA di bawah ini dapat membantu Anda.

1. Pilih email yang ingin Anda ekstrak URL-nya, dan tekan lain + F11 kunci untuk mengaktifkan Microsoft Visual Basic untuk Aplikasi jendela.

2. klik Menyisipkan > Modul untuk membuat modul kosong baru, lalu salin dan tempel kode di bawah ini ke modul.

VBA: ekstrak semua URL dari beberapa email ke file 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

Dalam kode ini, ia mengekstrak semua hyperlink dan teks tampilan yang sesuai dan subjek email.

3. klik Tools > Referensi untuk mengaktifkan Referensi – Proyek 1 dialog, centang Perpustakaan Objek Microsoft Excel 16.0 dan Perpustakaan objek Microsoft Word 16.0 kotak centang. Klik OK.

4. Kemudian letakkan kursor di dalam kode VBA, tekan F5 kunci atau klik Run tombol untuk menjalankan kode, sekarang buku kerja muncul dan semua URL telah diekstraksi di dalamnya, lalu Anda dapat menyimpannya ke folder.

Note: semua VBA di atas mengekstrak semua jenis hyperlink.

---

Alat Produktivitas Kantor Terbaik

Kutools untuk Outlook - Lebih dari 100 Fitur Canggih untuk Meningkatkan Outlook Anda

🤖 Asisten Surat AI: Email profesional instan dengan keajaiban AI--satu klik untuk mendapatkan balasan jenius, nada sempurna, penguasaan multibahasa. Ubah email dengan mudah! ...

📧 Email Otomatis: Di Luar Kantor (Tersedia untuk POP dan IMAP)  /  Jadwal Kirim Email  /  Auto CC/BCC Sesuai Aturan Saat Mengirim Email  /  Penerusan Otomatis (Aturan Lanjutan)   /  Tambah Salam Otomatis   /  Secara Otomatis Membagi Email Multi-Penerima menjadi Pesan Individual ...

📨 email Management: Mengingat Email dengan Mudah  /  Blokir Email Penipuan berdasarkan Subjek dan Lainnya  /  Hapus Email Duplikat  /  Pencarian  /  Konsolidasi Folder ...

📁 Lampiran Pro: Penyimpanan Batch  /  Pelepasan Batch  /  Kompres Batch  /  Penyimpanan otomatis   /  Lepaskan Otomatis  /  Kompres Otomatis ...

🌟 Antarmuka Ajaib: 😊Lebih Banyak Emoji Cantik dan Keren   /  Tingkatkan Produktivitas Outlook Anda dengan Tampilan Tab  /  Minimalkan Outlook Daripada Menutup ...

👍 Keajaiban sekali klik: Balas Semua dengan Lampiran Masuk  /   Email Anti-Phishing  /  🕘Tampilkan Zona Waktu Pengirim ...

👩🏼‍🤝‍👩🏻 Kontak & Kalender: Batch Tambahkan Kontak Dari Email yang Dipilih  /  Bagi Grup Kontak menjadi Grup Individual  /  Hapus Pengingat Ulang Tahun ...

Lebih 100 Fitur Tunggu Eksplorasi Anda! Klik Di Sini untuk Menemukan Lebih Banyak.

Baca Selengkapnya       Free download      Pembelian