Outlook: Bir e-postadan tüm URL’leri nasıl çıkarılır

Bir e-posta içinde yüzlerce URL varsa ve bunların tamamını bir metin dosyasına çıkarmak gerekiyorsa, hepsini tek tek kopyalayıp yapıştırmak son derece sıkıcı olur. Bu öğretici, bir e-postadaki tüm URL’leri hızla çıkarmanıza olanak tanıyan VBA kodlarını tanıtıyor.

Bir e-postadan URL’leri bir Metin dosyası içine çıkarmak için VBA

Birden fazla e-postadan URL’leri bir Excel dosyasına çıkarmak için VBA

Bir e-postadan URL’leri bir Metin dosyası içine çıkarmak için VBA

1. URL’lerini çıkarmak istediğiniz bir e-postayı seçin ve Alt+F11 tuşlarına basarak Microsoft Visual Basic for Applications penceresini açın.

2. Yeni bir boş modül oluşturmak için Ekle > Modül seçeneğine tıklayın, ardından aşağıdaki kodu modüle kopyalayıp yapıştırın.

VBA: Bir e-postadaki tüm URL’leri metin dosyasına çıkarın.

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

Bu kod, adı "E-posta Konusu" ile belirlenen ve şu yolda kaydedilen yeni bir metin dosyası oluşturacaktır: C:\Users\Public\Downloads. Gerekirse bu yolu değiştirebilirsiniz.

3. Araçlar > Başvurular seçeneğine tıklayarak Başvurular – Proje 1 iletişim kutusunu açın, ardından Microsoft VBScript Regular Expressions 5,5 onay kutusunu işaretleyin ve Tamam düğmesine tıklayın.

4. Kodu çalıştırmak için F5 tuşuna basın veya Çalıştır düğmesine tıklayın; ardından bir Metin dosyası açılır ve tüm URL’ler içine çıkarılmış olur.

Not: Outlook 2010 veya Outlook 365 kullanıyorsanız, 3. adımda ayrıca Windows Script Host Nesne Modeli onay kutusunu da işaretleyin. Ardından Tamam’a tıklayın.

Birden fazla e-postadan URL’leri bir Excel dosyasına çıkarmak için VBA

Birden fazla seçili e-postadan URL’leri bir Excel dosyasına çıkarmak istiyorsanız, aşağıdaki VBA kodu işinizi kolaylaştırabilir.

1. URL’lerini çıkarmak istediğiniz bir e-postayı seçin ve Alt+F11tuşlarına basarak Microsoft Visual Basic for Applicationspenceresini açın.

2. Yeni bir boş modül oluşturmak için Ekle > Modül seçeneğine tıklayın, ardından aşağıdaki kodu modüle kopyalayıp yapıştırın.

VBA: Birden fazla e-postadan tüm URL’leri bir Excel dosyasına çıkarın

'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

Bu kod, tüm köprüleri ve bunlara karşılık gelen Görüntü Metni ile E-posta Konusu bilgilerini çıkarır.

3. Araçlar > Başvurular seçeneğine tıklayarak Başvurular – Proje 1 iletişim kutusunu açın, ardından Microsoft Excel 16,0 Nesne Kitaplığı ve Microsoft Word 16,0 Nesne Kitaplığı onay kutularını işaretleyin. Son olarak Tamam düğmesine tıklayın.

4. Ardından imleci VBA kodunun içine yerleştirin ve kodu çalıştırmak için F5 tuşuna basın ya da Çalıştır düğmesine tıklayın; ardından bir çalışma kitabı açılacak ve tüm URL’ler içinden çıkarılmış olarak karşınıza gelecek—bunu hemen bir klasöre kaydedebilirsiniz.

Not: Yukarıdaki tüm VBA kodları her tür köprüyü kaldırır.

---

En İyi Office Verimlilik Araçları

Yepyeni Kutools for Outlook’i 100+ muhteşem özelliğiyle deneyimleyin!Şimdi indirmek için tıklayın!

🤖KUTOOLS AI:E-postaları yanıtlama, özetleme, iyileştirme, uzatma, çevirme ve yazma dahil olmak üzere zahmetsizce yönetmek için gelişmiş yapay zeka teknolojisi kullanır.

📧E-posta Otomasyonu: Otomatik Yanıt (POP ve IMAP için kullanılabilir) / E-postaları Zamanlayarak Gönderme / E-posta Gönderirken Kurallara Göre Otomatik CC/BCC / Otomatik Yönlendirme (Gelişmiş Kurallar) / Otomatik Selam Mesajı Ekleme / Çok Alıcılı E-postaları Otomatik Olarak Bireysel Mesajlara Bölme…

📨E-posta Yönetimi: E-postayı Geri Çağırma, Konu Başlıklarına ve Diğerlerine Göre Dolandırıcılık E-postalarını Engelleme, Yinelenen E-postaları Silme, Gelişmiş Arama, Klasörleri Düzenleme…

📁Ek Dosyalar Pro: Toplu Kaydetme, Toplu Ayırma, Toplu Sıkıştırma, Otomatik Kaydet, Otomatik Ayır ve Otomatik Sıkıştır…

🌟Arayüz Büyüsü: 😊 Daha Güzel ve Havalı Emojiler / Önemli e-postalar geldiğinde sizi uyarır / Outlook’u Kapatmak Yerine Simge Durumuna Küçültür…

👍Tek Tıkla Harikalar: Tümüne Eklerle Yanıtla / Phishing E-postalarına Karşı Koruma / 🕘 Gönderenin Mevcut Saati: Saat Dilimini Göster…

👩🏼‍🤝‍👩🏻Kişiler & Takvim:Seçili E-postalardan Toplu Kişi Ekleme/Bir Kişi Grubunu Bireysel Gruplara Bölme/Doğum Günü Hatırlatıcısını Kaldırma…

Kutools’u tercih ettiğiniz dilde kullanın – İngilizce, İspanyolca, Almanca, Fransızca, Çince ve 40’tan fazla başka dil desteğiyle!

Kutools for Outlook’u tek bir tıklamayla anında açın! Beklemeyin, hemen indirin ve verimliliğinizi artırın!

Kutools for Outlook Özellik Listesi      Şimdi İndirin      Satın Alma Sayfasına Git

🚀 Tek Tıkla İndir — Tüm Office Eklentilerini Edinin

Kesinlikle Önerilir: Kutools for Office (5’li Paket)

Beş yükleyiciyi tek tıklabir seferde indirin —Kutools for Excel, Outlook, Word, PowerPointve Office Tab Pro.Şimdi indirmek için tıklayın!

• ✅Tek tıkla kolaylık: Tüm beş kurulum paketini tek seferde indirin.
• 🚀Her Office görevine hazır: İhtiyacınız olduğunda, ihtiyacınız olan eklentileri yükleyin.
• 🧰İçerik: Kutools for Excel / Kutools for Outlook / Kutools for Word / Office Tab Pro / Kutools for PowerPoint

Paket Hakkında⬇ Paketi İndirin💳 Paketi Satın Alın